Fix Trac #959: a long-standing bug in instantiating otherwise-unbound type variables
[ghc-hetmet.git] / compiler / iface / TcIface.lhs
index 156a1aa..6a55957 100644 (file)
@@ -6,17 +6,10 @@
 Type checking of type signatures in interface files
 
 \begin{code}
 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/Commentary/CodingStyle#Warnings
--- for details
-
 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"
@@ -29,6 +22,7 @@ import TcRnMonad
 import Type
 import TypeRep
 import HscTypes
 import Type
 import TypeRep
 import HscTypes
+import Annotations
 import InstEnv
 import FamInstEnv
 import CoreSyn
 import InstEnv
 import FamInstEnv
 import CoreSyn
@@ -43,12 +37,12 @@ import Class
 import TyCon
 import DataCon
 import TysWiredIn
 import TyCon
 import DataCon
 import TysWiredIn
+import TysPrim         ( anyTyConOfKind )
 import Var              ( TyVar )
 import qualified Var
 import VarEnv
 import Name
 import NameEnv
 import Var              ( TyVar )
 import qualified Var
 import VarEnv
 import Name
 import NameEnv
-import OccName
 import Module
 import LazyUniqFM
 import UniqSupply
 import Module
 import LazyUniqFM
 import UniqSupply
@@ -59,10 +53,10 @@ import SrcLoc
 import DynFlags
 import Util
 import FastString
 import DynFlags
 import Util
 import FastString
+import BasicTypes (Arity)
 
 import Control.Monad
 import Data.List
 
 import Control.Monad
 import Data.List
-import Data.Maybe
 \end{code}
 
 This module takes
 \end{code}
 
 This module takes
@@ -74,7 +68,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 
@@ -113,8 +107,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)
@@ -123,25 +118,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
@@ -150,10 +126,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 
@@ -171,6 +148,83 @@ importDecl name
 
 %************************************************************************
 %*                                                                     *
 
 %************************************************************************
 %*                                                                     *
+           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}
+
+%************************************************************************
+%*                                                                     *
                Type-checking a complete interface
 %*                                                                     *
 %************************************************************************
                Type-checking a complete interface
 %*                                                                     *
 %************************************************************************
@@ -205,10 +259,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 
@@ -224,6 +279,7 @@ 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
                              }
@@ -264,7 +320,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.  
@@ -356,60 +412,51 @@ tcIfaceDecl :: Bool       -- True <=> discard IdInfo on IfaceId bindings
            -> IfaceDecl
            -> IfL TyThing
 
            -> IfaceDecl
            -> IfL TyThing
 
-tcIfaceDecl ignore_prags (IfaceId {ifName = occ_name, ifType = iface_type, ifIdInfo = info})
+tcIfaceDecl 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 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)) }
+
+tcIfaceDecl _ (IfaceData {ifName = occ_name, 
+                         ifTyVars = tv_bndrs, 
+                         ifCtxt = ctxt, ifGadtSyntax = gadt_syn,
+                         ifCons = rdr_cons, 
+                         ifRec = is_rec, 
+                         ifGeneric = want_generic,
+                         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)
-                      }
+           ; mb_fam_inst  <- tcFamInst mb_family
            ; cons <- tcIfaceDataCons tc_name tycon tyvars rdr_cons
            ; buildAlgTyCon tc_name tyvars stupid_theta
            ; cons <- tcIfaceDataCons tc_name tycon tyvars rdr_cons
            ; buildAlgTyCon tc_name tyvars stupid_theta
-                           cons is_rec want_generic gadt_syn famInst
+                           cons is_rec want_generic gadt_syn 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
+    ; traceIf (text "tcIfaceDecl4" <+> ppr tycon)
+    ; return (ATyCon tycon) }
+
+tcIfaceDecl _ (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
      { 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
+     ; rhs_kind <- tcIfaceType kind    -- Note [Synonym kind loop]
+     ; ~(rhs, fam) <- forkM (mk_doc tc_name) $ 
+                             do { rhs <- tc_syn_rhs rhs_kind mb_rhs_ty
+                        ; fam <- tcFamInst mb_family
+                        ; return (rhs, fam) }
+     ; tycon <- buildSynTyCon tc_name tyvars rhs rhs_kind fam
      ; return $ ATyCon tycon
      }
      ; return $ ATyCon tycon
      }
+   where
+     mk_doc n = ptext (sLit "Type syonym") <+> ppr n
+     tc_syn_rhs kind Nothing   = return (OpenSynTyCon kind Nothing)
+     tc_syn_rhs _    (Just ty) = do { rhs_ty <- tcIfaceType ty
+                                   ; return (SynonymTyCon rhs_ty) }
 
 tcIfaceDecl ignore_prags
            (IfaceClass {ifCtxt = rdr_ctxt, ifName = occ_name, 
 
 tcIfaceDecl ignore_prags
            (IfaceClass {ifCtxt = rdr_ctxt, ifName = occ_name, 
@@ -424,7 +471,7 @@ tcIfaceDecl ignore_prags
     ; sigs <- mapM tc_sig rdr_sigs
     ; fds  <- mapM tc_fd rdr_fds
     ; ats' <- mapM (tcIfaceDecl ignore_prags) rdr_ats
     ; sigs <- mapM tc_sig rdr_sigs
     ; fds  <- mapM tc_fd rdr_fds
     ; ats' <- mapM (tcIfaceDecl ignore_prags) rdr_ats
-    ; let ats = zipWith setTyThingPoss ats' (map ifTyVars rdr_ats)
+    ; let ats = map (setAssocFamilyPermutation tyvars) ats'
     ; cls  <- buildClass ignore_prags cls_name tyvars ctxt fds ats sigs tc_isrec
     ; return (AClass cls) }
   where
     ; cls  <- buildClass ignore_prags cls_name tyvars ctxt fds ats sigs tc_isrec
     ; return (AClass cls) }
   where
@@ -442,25 +489,19 @@ tcIfaceDecl ignore_prags
                           ; tvs2' <- mapM tcIfaceTyVar tvs2
                           ; return (tvs1', tvs2') }
 
                           ; 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})
+tcIfaceDecl _ (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
        IfOpenDataTyCon  -> return mkOpenDataTyConRhs
   = case if_cons of
        IfAbstractTyCon  -> return mkAbstractTyConRhs
        IfOpenDataTyCon  -> return mkOpenDataTyConRhs
@@ -493,14 +534,19 @@ tcIfaceDataCons tycon_name tycon tc_tyvars if_cons
        ; arg_tys <- forkM (mk_doc name) (mapM tcIfaceType args)
        ; lbl_names <- mapM 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
@@ -509,6 +555,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.
 
 %************************************************************************
 %*                                                                     *
 
 %************************************************************************
 %*                                                                     *
@@ -519,8 +582,7 @@ 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 })
+                        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
   = do { dfun    <- forkM (ptext (sLit "Dict fun") <+> ppr dfun_occ) $
                     tcIfaceExtId dfun_occ
         ; let mb_tcs' = map (fmap ifaceTyConName) mb_tcs
@@ -530,7 +592,7 @@ tcIfaceFamInst :: IfaceFamInst -> IfL FamInst
 tcIfaceFamInst (IfaceFamInst { ifFamInstTyCon = tycon, 
                               ifFamInstFam = fam, ifFamInstTys = mb_tcs })
 --     { tycon'  <- forkM (ptext (sLit "Inst tycon") <+> ppr tycon) $
 tcIfaceFamInst (IfaceFamInst { ifFamInstTyCon = tycon, 
                               ifFamInstFam = fam, ifFamInstTys = mb_tcs })
 --     { tycon'  <- forkM (ptext (sLit "Inst tycon") <+> ppr tycon) $
--- ^^^this line doesn't work, but vvv this does => CPP in Haskell = evil!
+-- 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
     = do tycon'  <- forkM (text ("Inst tycon") <+> ppr tycon) $
                     tcIfaceTyCon tycon
          let mb_tcs' = map (fmap ifaceTyConName) mb_tcs
@@ -558,8 +620,7 @@ tcIfaceRules ignore_prags if_rules
 
 tcIfaceRule :: IfaceRule -> IfL CoreRule
 tcIfaceRule (IfaceRule {ifRuleName = name, ifActivation = act, ifRuleBndrs = bndrs,
 
 tcIfaceRule :: IfaceRule -> IfL CoreRule
 tcIfaceRule (IfaceRule {ifRuleName = name, ifActivation = act, ifRuleBndrs = bndrs,
-                       ifRuleHead = fn, ifRuleArgs = args, ifRuleRhs = rhs,
-                       ifRuleOrph = orph })
+                       ifRuleHead = fn, ifRuleArgs = args, ifRuleRhs = rhs })
   = do { ~(bndrs', args', rhs') <- 
                -- Typecheck the payload lazily, in the hope it'll never be looked at
                forkM (ptext (sLit "Rule") <+> ftext name) $
   = do { ~(bndrs', args', rhs') <- 
                -- Typecheck the payload lazily, in the hope it'll never be looked at
                forkM (ptext (sLit "Rule") <+> ftext name) $
@@ -585,9 +646,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}
 
 
@@ -695,6 +784,7 @@ tcIfaceType (IfaceTyConApp tc ts) = do { tc' <- tcIfaceTyCon tc; ts' <- tcIfaceT
 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 (IfaceForAllTy tv t)  = bindIfaceTyVar tv $ \ tv' -> do { t' <- tcIfaceType t; return (ForAllTy tv' t') }
 tcIfaceType (IfacePredTy st)      = do { st' <- tcIfacePredType st; return (PredTy st') }
 
+tcIfaceTypes :: [IfaceType] -> IfL [Type]
 tcIfaceTypes tys = mapM tcIfaceType tys
 
 -----------------------------------------
 tcIfaceTypes tys = mapM tcIfaceType tys
 
 -----------------------------------------
@@ -800,6 +890,9 @@ tcIfaceExpr (IfaceNote note expr) = do
         IfaceCoreNote n   -> return (Note (CoreNote n) 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 ) do
     rhs' <- tcIfaceExpr rhs
 tcIfaceAlt _ _ (IfaceDefault, names, rhs)
   = ASSERT( null names ) do
     rhs' <- tcIfaceExpr rhs
@@ -819,11 +912,13 @@ tcIfaceAlt scrut (tycon, inst_tys) (IfaceDataAlt data_occ, arg_strs, rhs)
               (failIfM (ppr scrut $$ ppr con $$ ppr tycon $$ ppr (tyConDataCons tycon)))
        ; tcIfaceDataAlt con inst_tys arg_strs rhs }
                  
               (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)
+tcIfaceAlt _ (tycon, inst_tys) (IfaceTupleAlt _boxity, arg_occs, rhs)
   = ASSERT( isTupleTyCon tycon )
     do { let [data_con] = tyConDataCons tycon
        ; tcIfaceDataAlt data_con inst_tys arg_occs rhs }
 
   = ASSERT( isTupleTyCon 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
 tcIfaceDataAlt con inst_tys arg_strs rhs
   = do { us <- newUniqueSupply
        ; let uniqs = uniqsFromSupply us
@@ -869,6 +964,13 @@ do_one (IfaceRec pairs) thing_inside
 %************************************************************************
 
 \begin{code}
 %************************************************************************
 
 \begin{code}
+tcIdDetails :: IfaceIdDetails -> IfL IdDetails
+tcIdDetails IfVanillaId = return VanillaId
+tcIdDetails IfDFunId    = return DFunId
+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
@@ -880,6 +982,7 @@ 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 :: 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 `setAllStrictnessInfo` Just str)
     tcPrag info HsNoCafRefs         = return (info `setCafInfo`   NoCafRefs)
     tcPrag info (HsArity arity)     = return (info `setArityInfo` arity)
     tcPrag info (HsStrictness str)  = return (info `setAllStrictnessInfo` Just str)
@@ -899,6 +1002,7 @@ tcIdInfo ignore_prags name ty info
 \end{code}
 
 \begin{code}
 \end{code}
 
 \begin{code}
+tcWorkerInfo :: Type -> IdInfo -> Name -> Arity -> IfL IdInfo
 tcWorkerInfo ty info wkr arity
   = do         { mb_wkr_id <- forkM_maybe doc (tcIfaceExtId wkr)
 
 tcWorkerInfo ty info wkr arity
   = do         { mb_wkr_id <- forkM_maybe doc (tcIfaceExtId wkr)
 
@@ -969,7 +1073,7 @@ 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
   = do { env <- getGblEnv
        ; case if_rec_types env of {    -- Note [Tying the knot]
   | otherwise
   = do { env <- getGblEnv
        ; case if_rec_types env of {    -- Note [Tying the knot]
@@ -979,14 +1083,14 @@ tcIfaceGlobal name
                { type_env <- setLclEnv () get_type_env         -- yuk
                ; case lookupNameEnv type_env name of
                        Just thing -> return thing
                { 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
 
 
-       { (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
 
            Just thing -> return thing ;
            Nothing    -> do
 
@@ -1012,21 +1116,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).
 
 -- 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
 tcIfaceTyCon :: IfaceTyCon -> IfL TyCon
 tcIfaceTyCon IfaceIntTc        = tcWiredInTyCon intTyCon
 tcIfaceTyCon IfaceBoolTc       = tcWiredInTyCon boolTyCon
@@ -1034,13 +1123,15 @@ 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
     check_tc tc
      | debugIsOn = case toIfaceTyCon tc of
                    IfaceTc _ -> tc
 tcIfaceTyCon (IfaceTc name)     = do { thing <- tcIfaceGlobal name 
                                     ; return (check_tc (tyThingTyCon thing)) }
   where
     check_tc tc
      | debugIsOn = case toIfaceTyCon tc of
                    IfaceTc _ -> tc
-                   other     -> pprTrace "check_tc" (ppr tc) tc
+                   _         -> pprTrace "check_tc" (ppr tc) tc
      | otherwise = tc
 -- we should be okay just returning Kind constructors without extra loading
 tcIfaceTyCon IfaceLiftedTypeKindTc   = return liftedTypeKindTyCon
      | otherwise = tc
 -- we should be okay just returning Kind constructors without extra loading
 tcIfaceTyCon IfaceLiftedTypeKindTc   = return liftedTypeKindTyCon
@@ -1053,7 +1144,7 @@ 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
                       ; return tc }
 
 tcIfaceClass :: Name -> IfL Class
@@ -1064,13 +1155,13 @@ tcIfaceDataCon :: Name -> IfL DataCon
 tcIfaceDataCon name = do { thing <- tcIfaceGlobal name
                         ; case thing of
                                ADataCon dc -> return dc
 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}
 
 %************************************************************************
@@ -1096,7 +1187,9 @@ bindIfaceBndrs (b:bs) thing_inside
     bindIfaceBndrs bs  $ \ bs' ->
     thing_inside (b':bs')
 
     bindIfaceBndrs bs  $ \ bs' ->
     thing_inside (b':bs')
 
+
 -----------------------
 -----------------------
+tcIfaceLetBndr :: IfaceLetBndr -> IfL Id
 tcIfaceLetBndr (IfLetBndr fs ty info)
   = do { name <- newIfaceName (mkVarOccFS fs)
        ; ty' <- tcIfaceType ty
 tcIfaceLetBndr (IfLetBndr fs ty info)
   = do { name <- newIfaceName (mkVarOccFS fs)
        ; ty' <- tcIfaceType ty
@@ -1123,13 +1216,13 @@ 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)
+  = do { names <- newIfaceNames (map mkTyVarOccFS occs)
        ; tyvars <- zipWithM mk_iface_tyvar names kinds
        ; extendIfaceTyVarEnv tyvars (thing_inside tyvars) }
   where
        ; tyvars <- zipWithM mk_iface_tyvar names kinds
        ; extendIfaceTyVarEnv tyvars (thing_inside tyvars) }
   where
@@ -1142,5 +1235,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}