merge GHC HEAD
[ghc-hetmet.git] / compiler / iface / TcIface.lhs
index 7416a5f..f29bf85 100644 (file)
@@ -9,7 +9,7 @@ Type checking of type signatures in interface files
 module TcIface ( 
        tcImportDecl, checkWiredInTyCon, tcHiBootIface, typecheckIface, 
        tcIfaceDecl, tcIfaceInst, tcIfaceFamInst, tcIfaceRules,
 module TcIface ( 
        tcImportDecl, checkWiredInTyCon, tcHiBootIface, typecheckIface, 
        tcIfaceDecl, tcIfaceInst, tcIfaceFamInst, tcIfaceRules,
-       tcIfaceVectInfo, tcIfaceGlobal, tcExtCoreBindings
+       tcIfaceVectInfo, tcIfaceAnnotations, tcIfaceGlobal, tcExtCoreBindings
  ) where
 
 #include "HsVersions.h"
  ) where
 
 #include "HsVersions.h"
@@ -19,9 +19,12 @@ import LoadIface
 import IfaceEnv
 import BuildTyCl
 import TcRnMonad
 import IfaceEnv
 import BuildTyCl
 import TcRnMonad
+import TcType
 import Type
 import Type
+import Coercion
 import TypeRep
 import HscTypes
 import TypeRep
 import HscTypes
+import Annotations
 import InstEnv
 import FamInstEnv
 import CoreSyn
 import InstEnv
 import FamInstEnv
 import CoreSyn
@@ -36,12 +39,14 @@ import Class
 import TyCon
 import DataCon
 import TysWiredIn
 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 qualified Var
 import VarEnv
 import Name
 import NameEnv
-import OccName
+import OccurAnal       ( occurAnalyseExpr )
+import Demand          ( isBottomingSig )
 import Module
 import UniqFM
 import UniqSupply
 import Module
 import UniqFM
 import UniqSupply
@@ -50,10 +55,11 @@ import ErrUtils
 import Maybes
 import SrcLoc
 import DynFlags
 import Maybes
 import SrcLoc
 import DynFlags
-import Control.Monad
+import Util
+import FastString
 
 
+import Control.Monad
 import Data.List
 import Data.List
-import Data.Maybe
 \end{code}
 
 This module takes
 \end{code}
 
 This module takes
@@ -65,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.
 
 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 
        -- 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 
@@ -104,8 +110,9 @@ tcImportDecl :: Name -> TcM TyThing
 -- Entry point for *source-code* uses of importDecl
 tcImportDecl name 
   | Just thing <- wiredInNameTyThing_maybe name
 -- 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)
        ; return thing }
   | otherwise
   = do         { traceIf (text "tcImportDecl" <+> ppr name)
@@ -114,25 +121,6 @@ tcImportDecl name
            Succeeded thing -> return thing
            Failed err      -> failWithTc err }
 
            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
 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
@@ -141,10 +129,11 @@ importDecl name
     do { traceIf nd_doc
 
        -- Load the interface, which should populate the PTE
     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) ;
        ; 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 
 
        -- Now look it up again; this time we should find it
        { eps <- getEps 
@@ -153,11 +142,88 @@ importDecl name
            Nothing    -> return (Failed not_found_msg)
     }}}
   where
            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") <+>
-                               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")])
+    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 (nameOccName 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")])
+\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}
 
 %************************************************************************
 \end{code}
 
 %************************************************************************
@@ -196,10 +262,11 @@ typecheckIface iface
        ; let type_env = mkNameEnv names_w_things
        ; writeMutVar tc_env_var type_env
 
        ; 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)
        ; 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 
 
                 -- Vectorisation information
         ; vect_info <- tcIfaceVectInfo (mi_module iface) type_env 
@@ -215,9 +282,9 @@ typecheckIface iface
                              , md_insts     = insts
                              , md_fam_insts = fam_insts
                              , md_rules     = rules
                              , md_insts     = insts
                              , md_fam_insts = fam_insts
                              , md_rules     = rules
+                             , md_anns      = anns
                               , md_vect_info = vect_info
                              , md_exports   = exports
                               , md_vect_info = vect_info
                              , md_exports   = exports
-                              , md_modBreaks = emptyModBreaks
                              }
     }
 \end{code}
                              }
     }
 \end{code}
@@ -256,7 +323,7 @@ tcHiBootIface hsc_src mod
                  ; case lookupUFM hpt (moduleName mod) of
                      Just info | mi_boot (hm_iface info) 
                                -> return (hm_details info)
                  ; 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.  
          else do
 
        -- OK, so we're in one-shot mode.  
@@ -282,13 +349,13 @@ tcHiBootIface hsc_src mod
                Succeeded (iface, _path) -> typecheckIface iface
     }}}}
   where
                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}
 
                          quotes (ppr mod) <> colon) 4 err
 \end{code}
 
@@ -347,63 +414,57 @@ the forkM stuff.
 tcIfaceDecl :: Bool    -- True <=> discard IdInfo on IfaceId bindings
            -> IfaceDecl
            -> IfL TyThing
 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
   = do { name <- lookupIfaceTop occ_name
        ; ty <- tcIfaceType iface_type
+       ; details <- tcIdDetails ty details
        ; info <- tcIdInfo ignore_prags name ty info
        ; 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
            { 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
            ; 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, 
            (IfaceClass {ifCtxt = rdr_ctxt, ifName = occ_name, 
                         ifTyVars = tv_bndrs, ifFDs = rdr_fds, 
                         ifATs = rdr_ats, ifSigs = rdr_sigs, 
@@ -413,11 +474,11 @@ tcIfaceDecl ignore_prags
   = bindIfaceTyVars tv_bndrs $ \ tyvars -> do
     { cls_name <- lookupIfaceTop occ_name
     ; ctxt <- tcIfaceCtxt rdr_ctxt
   = 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)
     ; return (AClass cls) }
   where
    tc_sig (IfaceClassOp occ dm rdr_ty)
@@ -428,35 +489,29 @@ tcIfaceDecl ignore_prags
                -- it mentions unless it's necessray to do so
          ; return (op_name, dm, op_ty) }
 
                -- 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') }
 
                           ; 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)) }
 
   = 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
   = 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 }
                                ; return (mkDataTyConRhs data_cons) }
        IfNewTyCon con   -> do  { data_con <- tc_con_decl con
                                ; mkNewTyConRhs tycon_name tycon data_con }
@@ -482,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
 
        -- 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 
 
        ; 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
 tcIfaceEqSpec spec
   = mapM do_item spec
   where
@@ -501,6 +561,23 @@ tcIfaceEqSpec spec
                               ; return (tv,ty) }
 \end{code}
 
                               ; 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.
 
 %************************************************************************
 %*                                                                     *
 
 %************************************************************************
 %*                                                                     *
@@ -511,9 +588,8 @@ tcIfaceEqSpec spec
 \begin{code}
 tcIfaceInst :: IfaceInst -> IfL Instance
 tcIfaceInst (IfaceInst { ifDFun = dfun_occ, ifOFlag = oflag,
 \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) }
                     tcIfaceExtId dfun_occ
         ; let mb_tcs' = map (fmap ifaceTyConName) mb_tcs
        ; return (mkImportedInstance cls mb_tcs' dfun oflag) }
@@ -521,12 +597,12 @@ tcIfaceInst (IfaceInst { ifDFun = dfun_occ, ifOFlag = oflag,
 tcIfaceFamInst :: IfaceFamInst -> IfL FamInst
 tcIfaceFamInst (IfaceFamInst { ifFamInstTyCon = tycon, 
                               ifFamInstFam = fam, ifFamInstTys = mb_tcs })
 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}
 
 
 \end{code}
 
 
@@ -551,20 +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,
 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
   = 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' ->
                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
                   ; rhs'  <- tcIfaceExpr rhs
                   ; return (bndrs', args', rhs') }
        ; let mb_tcs = map ifTopFreeName args
-        ; lcl <- getLclEnv
-       ; 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_bndrs = bndrs', ru_args = args', 
-                         ru_rhs = rhs', 
+                         ru_rhs = occurAnalyseExpr rhs', 
                          ru_rough = mb_tcs,
                          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
                          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
@@ -578,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)
        -- 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 (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}
 
 
 \end{code}
 
 
@@ -599,12 +703,13 @@ tcIfaceVectInfo mod typeEnv (IfaceVectInfo
                              })
   = do { vVars     <- mapM vectVarMapping vars
        ; tyConRes1 <- mapM vectTyConMapping      tycons
                              })
   = do { vVars     <- mapM vectVarMapping vars
        ; tyConRes1 <- mapM vectTyConMapping      tycons
-       ; tyConRes2 <- mapM vectTyConReuseMapping tycons
-       ; let (vTyCons, vDataCons, vIsos) = unzip3 (tyConRes1 ++ tyConRes2)
+       ; tyConRes2 <- mapM vectTyConReuseMapping tyconsReuse
+       ; let (vTyCons, vDataCons, vPAs, vIsos) = unzip4 (tyConRes1 ++ tyConRes2)
        ; return $ VectInfo 
                   { vectInfoVar     = mkVarEnv  vVars
                   , vectInfoTyCon   = mkNameEnv vTyCons
                   , vectInfoDataCon = mkNameEnv (concat vDataCons)
        ; return $ VectInfo 
                   { vectInfoVar     = mkVarEnv  vVars
                   , vectInfoTyCon   = mkNameEnv vTyCons
                   , vectInfoDataCon = mkNameEnv (concat vDataCons)
+                  , vectInfoPADFun  = mkNameEnv vPAs
                   , vectInfoIso     = mkNameEnv vIsos
                   }
        }
                   , vectInfoIso     = mkNameEnv vIsos
                   }
        }
@@ -618,25 +723,31 @@ tcIfaceVectInfo mod typeEnv (IfaceVectInfo
            }
     vectTyConMapping name 
       = do { vName   <- lookupOrig mod (mkVectTyConOcc (nameOccName name))
            }
     vectTyConMapping name 
       = do { vName   <- lookupOrig mod (mkVectTyConOcc (nameOccName name))
+           ; paName  <- lookupOrig mod (mkPADFunOcc    (nameOccName name))
            ; isoName <- lookupOrig mod (mkVectIsoOcc   (nameOccName name))
            ; let { tycon    = lookupTyCon name
                  ; vTycon   = lookupTyCon vName
            ; isoName <- lookupOrig mod (mkVectIsoOcc   (nameOccName name))
            ; let { tycon    = lookupTyCon name
                  ; vTycon   = lookupTyCon vName
+                 ; paTycon  = lookupVar paName
                  ; isoTycon = lookupVar isoName
                  }
            ; vDataCons <- mapM vectDataConMapping (tyConDataCons tycon)
            ; return ((name, (tycon, vTycon)),    -- (T, T_v)
                      vDataCons,                  -- list of (Ci, Ci_v)
                  ; isoTycon = lookupVar isoName
                  }
            ; vDataCons <- mapM vectDataConMapping (tyConDataCons tycon)
            ; return ((name, (tycon, vTycon)),    -- (T, T_v)
                      vDataCons,                  -- list of (Ci, Ci_v)
+                     (vName, (vTycon, paTycon)), -- (T_v, paT)
                      (name, (tycon, isoTycon)))  -- (T, isoT)
            }
     vectTyConReuseMapping name 
                      (name, (tycon, isoTycon)))  -- (T, isoT)
            }
     vectTyConReuseMapping name 
-      = do { isoName <- lookupOrig mod (mkVectIsoOcc   (nameOccName name))
+      = do { paName  <- lookupOrig mod (mkPADFunOcc    (nameOccName name))
+           ; isoName <- lookupOrig mod (mkVectIsoOcc   (nameOccName name))
            ; let { tycon      = lookupTyCon name
            ; let { tycon      = lookupTyCon name
+                 ; paTycon    = lookupVar paName
                  ; isoTycon   = lookupVar isoName
                  ; vDataCons  = [ (dataConName dc, (dc, dc)) 
                                 | dc <- tyConDataCons tycon]
                  }
            ; return ((name, (tycon, tycon)),     -- (T, T)
                      vDataCons,                  -- list of (Ci, Ci)
                  ; isoTycon   = lookupVar isoName
                  ; vDataCons  = [ (dataConName dc, (dc, dc)) 
                                 | dc <- tyConDataCons tycon]
                  }
            ; return ((name, (tycon, tycon)),     -- (T, T)
                      vDataCons,                  -- list of (Ci, Ci)
+                     (name, (tycon, paTycon)),   -- (T, paT)
                      (name, (tycon, isoTycon)))  -- (T, isoT)
            }
     vectDataConMapping datacon
                      (name, (tycon, isoTycon)))  -- (T, isoT)
            }
     vectDataConMapping datacon
@@ -679,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 (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
 
 -----------------------------------------
 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 :: 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}
 
 
 \end{code}
 
 
@@ -704,54 +852,51 @@ tcIfaceCtxt sts = mappM tcIfacePredType sts
 \begin{code}
 tcIfaceExpr :: IfaceExpr -> IfL CoreExpr
 tcIfaceExpr (IfaceType ty)
 \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)
 
 tcIfaceExpr (IfaceLcl name)
-  = tcIfaceLclId name  `thenM` \ id ->
-    returnM (Var id)
+  = Var <$> tcIfaceLclId name
 
 tcIfaceExpr (IfaceTick modName tickNo)
 
 tcIfaceExpr (IfaceTick modName tickNo)
-  = tcIfaceTick modName tickNo `thenM` \ id ->
-    returnM (Var id)
+  = Var <$> tcIfaceTick modName tickNo
 
 tcIfaceExpr (IfaceExt gbl)
 
 tcIfaceExpr (IfaceExt gbl)
-  = tcIfaceExtId gbl   `thenM` \ id ->
-    returnM (Var id)
+  = Var <$> tcIfaceExtId gbl
 
 tcIfaceExpr (IfaceLit lit)
 
 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)
   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 (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
     let
        scrut_ty   = exprType scrut'
        case_bndr' = mkLocalId case_bndr_name scrut_ty
@@ -761,75 +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
                -- 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 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') }
 
 
-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
+    extendIfaceIdEnv [case_bndr'] $ do
+     alts' <- mapM (tcIfaceAlt scrut' tc_app) alts
+     return (Case scrut' case_bndr' (coreAltsType alts') alts')
 
 
-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
     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 _ (IfaceDefault, names, rhs)
-  = ASSERT( null names )
-    tcIfaceExpr rhs            `thenM` \ rhs' ->
-    returnM (DEFAULT, [], rhs')
+tcIfaceAlt :: CoreExpr -> (TyCon, [Type])
+           -> (IfaceConAlt, [FastString], IfaceExpr)
+           -> IfL (AltCon, [TyVar], CoreExpr)
+tcIfaceAlt _ _ (IfaceDefault, names, 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')
+tcIfaceAlt _ _ (IfaceLitAlt lit, names, 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!
 
 -- 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 (tycon, inst_tys) (IfaceDataAlt data_occ, arg_strs, rhs)
+tcIfaceAlt scrut (tycon, inst_tys) (IfaceDataAlt data_occ, arg_strs, rhs)
   = do { con <- tcIfaceDataCon data_occ
   = do { con <- tcIfaceDataCon data_occ
-       ; ASSERT2( con `elem` tyConDataCons tycon,
-                  ppr con $$ ppr tycon $$ ppr (tyConDataCons tycon) )
-         tcIfaceDataAlt con inst_tys arg_strs rhs }
+       ; 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 }
 
     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
 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
                      = 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
                  extendIfaceIdEnv arg_ids      $
                  tcIfaceExpr rhs
-       ; return (DataAlt con, all_tvs ++ arg_ids, rhs') }
+       ; return (DataAlt con, ex_tvs ++ arg_ids, rhs') }
 \end{code}
 
 
 \end{code}
 
 
@@ -847,9 +1001,9 @@ do_one (IfaceNonRec bndr rhs) thing_inside
        ; return (NonRec bndr' rhs' : core_binds) }}
 
 do_one (IfaceRec pairs) 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
        ; extendIfaceIdEnv bndrs' $ do
-       { rhss' <- mappM tcIfaceExpr rhss
+       { rhss' <- mapM tcIfaceExpr rhss
        ; core_binds <- thing_inside
        ; return (Rec (bndrs' `zip` rhss') : core_binds) }}
   where
        ; core_binds <- thing_inside
        ; return (Rec (bndrs' `zip` rhss') : core_binds) }}
   where
@@ -864,6 +1018,17 @@ do_one (IfaceRec pairs) thing_inside
 %************************************************************************
 
 \begin{code}
 %************************************************************************
 
 \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
 tcIdInfo :: Bool -> Name -> Type -> IfaceIdInfo -> IfL IdInfo
 tcIdInfo ignore_prags name ty info 
   | ignore_prags = return vanillaIdInfo
@@ -875,52 +1040,87 @@ tcIdInfo ignore_prags name ty info
     -- we start; default assumption is that it has CAFs
     init_info = vanillaIdInfo
 
     -- 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
 
        -- 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}
 \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
   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
                   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
 \end{code}
 
 For unfoldings we try to do the job lazily, so that we never type check
@@ -929,28 +1129,35 @@ an unfolding that isn't going to be looked at.
 \begin{code}
 tcPragExpr :: Name -> IfaceExpr -> IfL (Maybe CoreExpr)
 tcPragExpr name expr
 \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
   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}
 
 
 \end{code}
 
 
@@ -966,26 +1173,26 @@ tcIfaceGlobal :: Name -> IfL TyThing
 tcIfaceGlobal name
   | Just thing <- wiredInNameTyThing_maybe name
        -- Wired-in things include TyCons, DataCons, and Ids
 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
   | otherwise
-  = do { (eps,hpt) <- getEpsAndHpt
-       ; dflags <- getDOpts
-       ; case lookupType dflags hpt (eps_PTE eps) name of {
-           Just thing -> return thing ;
-           Nothing    -> do
-
-       { env <- getGblEnv
-       ; case if_rec_types env of {
+  = do { env <- getGblEnv
+       ; case if_rec_types env of {    -- Note [Tying the knot]
            Just (mod, get_type_env) 
                | nameIsLocalOrFrom mod name
                -> do           -- It's defined in the module being compiled
                { type_env <- setLclEnv () get_type_env         -- yuk
                ; case lookupNameEnv type_env name of
                        Just thing -> return thing
            Just (mod, get_type_env) 
                | nameIsLocalOrFrom mod name
                -> do           -- It's defined in the module being compiled
                { 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) }
 
                                                (ppr name $$ ppr type_env) }
 
-         ; other -> do
+         ; _ -> do
+
+       { hsc_env <- getTopEnv
+        ; mb_thing <- liftIO (lookupTypeHscEnv hsc_env name)
+       ; case mb_thing of {
+           Just thing -> return thing ;
+           Nothing    -> do
 
        { mb_thing <- importDecl name   -- It's imported; go get it
        ; case mb_thing of
 
        { mb_thing <- importDecl name   -- It's imported; go get it
        ; case mb_thing of
@@ -993,20 +1200,21 @@ tcIfaceGlobal name
            Succeeded thing -> return thing
     }}}}}
 
            Succeeded thing -> return thing
     }}}}}
 
-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) }
+-- Note [Tying the knot]
+-- ~~~~~~~~~~~~~~~~~~~~~
+-- The if_rec_types field is used in two situations:
+--
+-- a) Compiling M.hs, which indiretly imports Foo.hi, which mentions M.T
+--    Then we look up M.T in M's type environment, which is splatted into if_rec_types
+--    after we've built M's type envt.
+--
+-- b) In ghc --make, during the upsweep, we encounter M.hs, whose interface M.hi
+--    is up to date.  So we call typecheckIface on M.hi.  This splats M.T into 
+--    if_rec_types so that the (lazily typechecked) decls see all the other decls
+--
+-- In case (b) it's important to do the if_rec_types check *before* looking in the HPT
+-- 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).
 
 tcIfaceTyCon :: IfaceTyCon -> IfL TyCon
 tcIfaceTyCon IfaceIntTc        = tcWiredInTyCon intTyCon
 
 tcIfaceTyCon :: IfaceTyCon -> IfL TyCon
 tcIfaceTyCon IfaceIntTc        = tcWiredInTyCon intTyCon
@@ -1015,16 +1223,16 @@ tcIfaceTyCon IfaceCharTc        = tcWiredInTyCon charTyCon
 tcIfaceTyCon IfaceListTc       = tcWiredInTyCon listTyCon
 tcIfaceTyCon IfacePArrTc       = tcWiredInTyCon parrTyCon
 tcIfaceTyCon (IfaceTupTc bx ar) = tcWiredInTyCon (tupleTyCon bx ar)
 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
 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
 -- we should be okay just returning Kind constructors without extra loading
 tcIfaceTyCon IfaceLiftedTypeKindTc   = return liftedTypeKindTyCon
 tcIfaceTyCon IfaceOpenTypeKindTc     = return openTypeKindTyCon
@@ -1036,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
 -- 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) }
 
                       ; 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
 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
 
 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}
 
 %************************************************************************
 \end{code}
 
 %************************************************************************
@@ -1080,24 +1292,8 @@ bindIfaceBndrs (b:bs) thing_inside
     thing_inside (b':bs')
 
 -----------------------
     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 :: 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
   = do { mod <- getIfModule
        ; name <- newGlobalBinder mod (mkVarOccFS var) noSrcSpan
        ; ty' <- tcIfaceType ty
@@ -1106,14 +1302,14 @@ newExtCoreBndr (IfLetBndr var ty _)     -- Ignoring IdInfo for now
 -----------------------
 bindIfaceTyVar :: IfaceTvBndr -> (TyVar -> IfL a) -> IfL a
 bindIfaceTyVar (occ,kind) thing_inside
 -----------------------
 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
        ; 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
        ; extendIfaceTyVarEnv tyvars (thing_inside tyvars) }
   where
     (occs,kinds) = unzip bndrs
@@ -1125,5 +1321,20 @@ mk_iface_tyvar name ifKind
                return (Var.mkCoVar name kind)
          else
                return (Var.mkTyVar name kind) }
                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}