Implement INLINABLE pragma
[ghc-hetmet.git] / compiler / iface / TcIface.lhs
index 2dcdf78..07b0b72 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,11 @@ import LoadIface
 import IfaceEnv
 import BuildTyCl
 import TcRnMonad
 import IfaceEnv
 import BuildTyCl
 import TcRnMonad
+import TcType
 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
@@ -36,14 +38,17 @@ import Class
 import TyCon
 import DataCon
 import TysWiredIn
 import TyCon
 import DataCon
 import TysWiredIn
+import TysPrim         ( anyTyConOfKind )
 import Var              ( TyVar )
 import Var              ( TyVar )
+import BasicTypes      ( 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 Module
-import LazyUniqFM
+import UniqFM
 import UniqSupply
 import Outputable      
 import ErrUtils
 import UniqSupply
 import Outputable      
 import ErrUtils
@@ -52,11 +57,9 @@ 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
@@ -68,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 
@@ -107,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)
@@ -117,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
@@ -144,7 +129,8 @@ 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) ;
                Succeeded _ -> do
        ; case mb_iface of {
                Failed err_msg  -> return (Failed err_msg) ;
                Succeeded _ -> do
@@ -165,6 +151,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
 %*                                                                     *
 %************************************************************************
@@ -199,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 
@@ -218,6 +282,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
                              }
@@ -349,63 +414,58 @@ 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 (mkVanillaGlobalWithInfo 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 })
-  = 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, 
+                         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)
-                      }
            ; 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
+                           want_generic gadt_syn parent mb_fam_inst
            })
            })
-        ; traceIf (text "tcIfaceDecl4" <+> ppr tycon)
-       ; return (ATyCon tycon)
-    }}
-
-tcIfaceDecl _
-           (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, 
@@ -417,9 +477,9 @@ tcIfaceDecl ignore_prags
     ; ctxt <- tcIfaceCtxt rdr_ctxt
     ; sigs <- mapM tc_sig rdr_sigs
     ; fds  <- mapM tc_fd rdr_fds
     ; ctxt <- tcIfaceCtxt rdr_ctxt
     ; 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)
-    ; cls  <- buildClass ignore_prags cls_name tyvars ctxt fds ats sigs tc_isrec
+    ; 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)
@@ -436,29 +496,22 @@ 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 _ (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)) }
 
+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
 tcIfaceDataCons :: Name -> TyCon -> [TyVar] -> IfaceConDecls -> IfL AlgTyConRhs
 tcIfaceDataCons tycon_name tycon _ if_cons
   = case if_cons of
        IfAbstractTyCon  -> return mkAbstractTyConRhs
-       IfOpenDataTyCon  -> return mkOpenDataTyConRhs
+       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
        IfDataTyCon cons -> do  { data_cons <- mapM tc_con_decl cons
                                ; return (mkDataTyConRhs data_cons) }
        IfNewTyCon con   -> do  { data_con <- tc_con_decl con
@@ -488,11 +541,15 @@ tcIfaceDataCons tycon_name tycon _ 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
 
@@ -505,6 +562,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.
 
 %************************************************************************
 %*                                                                     *
 
 %************************************************************************
 %*                                                                     *
@@ -564,7 +638,7 @@ tcIfaceRule (IfaceRule {ifRuleName = name, ifActivation = act, ifRuleBndrs = bnd
        ; let mb_tcs = map ifTopFreeName args
        ; return (Rule { ru_name = name, ru_fn = fn, ru_act = act, 
                          ru_bndrs = bndrs', ru_args = args', 
        ; let mb_tcs = map ifTopFreeName args
        ; return (Rule { ru_name = name, ru_fn = fn, ru_act = act, 
                          ru_bndrs = bndrs', ru_args = args', 
-                         ru_rhs = rhs', 
+                         ru_rhs = occurAnalyseExpr rhs', 
                          ru_rough = mb_tcs,
                          ru_local = False }) } -- An imported RULE is never for a local Id
                                                -- or, even if it is (module loop, perhaps)
                          ru_rough = mb_tcs,
                          ru_local = False }) } -- An imported RULE is never for a local Id
                                                -- or, even if it is (module loop, perhaps)
@@ -587,6 +661,34 @@ tcIfaceRule (IfaceRule {ifRuleName = name, ifActivation = act, ifRuleBndrs = bnd
 
 %************************************************************************
 %*                                                                     *
 
 %************************************************************************
 %*                                                                     *
+               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}
+
+
+%************************************************************************
+%*                                                                     *
                Vectorisation information
 %*                                                                     *
 %************************************************************************
                Vectorisation information
 %*                                                                     *
 %************************************************************************
@@ -790,7 +892,6 @@ tcIfaceExpr (IfaceCast expr co) = do
 tcIfaceExpr (IfaceNote note expr) = do
     expr' <- tcIfaceExpr expr
     case note of
 tcIfaceExpr (IfaceNote note expr) = do
     expr' <- tcIfaceExpr expr
     case note of
-        IfaceInlineMe     -> return (Note InlineMe   expr')
         IfaceSCC cc       -> return (Note (SCC cc)   expr')
         IfaceCoreNote n   -> return (Note (CoreNote n) expr')
 
         IfaceSCC cc       -> return (Note (SCC cc)   expr')
         IfaceCoreNote n   -> return (Note (CoreNote n) expr')
 
@@ -818,7 +919,7 @@ tcIfaceAlt scrut (tycon, inst_tys) (IfaceDataAlt data_occ, arg_strs, rhs)
        ; tcIfaceDataAlt con inst_tys arg_strs rhs }
                  
 tcIfaceAlt _ (tycon, inst_tys) (IfaceTupleAlt _boxity, arg_occs, rhs)
        ; tcIfaceDataAlt con inst_tys arg_strs rhs }
                  
 tcIfaceAlt _ (tycon, inst_tys) (IfaceTupleAlt _boxity, arg_occs, rhs)
-  = ASSERT( isTupleTyCon tycon )
+  = 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 }
 
@@ -869,6 +970,17 @@ do_one (IfaceRec pairs) thing_inside
 %************************************************************************
 
 \begin{code}
 %************************************************************************
 
 \begin{code}
+tcIdDetails :: Type -> IfaceIdDetails -> IfL IdDetails
+tcIdDetails _  IfVanillaId = return VanillaId
+tcIdDetails ty IfDFunId
+  = return (DFunId (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
@@ -880,52 +992,77 @@ 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         = return (info `setCafInfo`   NoCafRefs)
-    tcPrag info (HsArity arity)     = return (info `setArityInfo` arity)
-    tcPrag info (HsStrictness str)  = return (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) = return (info `setInlinePragInfo` inline_prag)
-    tcPrag info (HsUnfold expr) = do
-          maybe_expr' <- tcPragExpr name 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' 
-          return (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 :: Type -> IdInfo -> Name -> Arity -> IfL IdInfo
-tcWorkerInfo ty info wkr arity
-  = do         { mb_wkr_id <- forkM_maybe doc (tcIfaceExtId wkr)
+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 True InlineStable expr arity 
+                                                 (UnfWhen unsat_ok boring_ok))
+    }
 
 
-       -- 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.)
+tcUnfolding name ty info (IfWrapper arity wkr)
+  = do         { mb_wkr_id <- forkM_maybe doc (tcIfaceExtId wkr)
        ; us <- newUniqueSupply
        ; us <- newUniqueSupply
-
        ; return (case mb_wkr_id of
        ; return (case mb_wkr_id of
-                    Nothing     -> info
-                    Just wkr_id -> add_wkr_info us wkr_id info) }
+                    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
                   Nothing  -> pprPanic "Worker info but no strictness for" (ppr wkr)
                   Just sig -> sig
                   Nothing  -> pprPanic "Worker info but no strictness for" (ppr wkr)
+
+tcUnfolding name dfun_ty _ (IfDFunUnfold ops)
+  = do { mb_ops1 <- forkM_maybe doc $ mapM tcIfaceExpr ops
+       ; return (case mb_ops1 of
+                           Nothing   -> noUnfolding
+                    Just ops1 -> mkDFunUnfolding dfun_ty ops1) }
+  where
+    doc = text "Class ops for dfun" <+> 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
@@ -970,7 +1107,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]
@@ -985,9 +1122,9 @@ tcIfaceGlobal name
 
          ; _ -> 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
 
@@ -1013,21 +1150,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
@@ -1035,6 +1157,8 @@ 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
@@ -1054,7 +1178,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
@@ -1097,6 +1221,7 @@ 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)
 -----------------------
 tcIfaceLetBndr :: IfaceLetBndr -> IfL Id
 tcIfaceLetBndr (IfLetBndr fs ty info)
@@ -1110,7 +1235,7 @@ tcIfaceLetBndr (IfLetBndr fs ty info)
     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 [] = 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 (HsStrictness s : i) = tc_info i `setStrictnessInfo` Just s 
     tc_info (other          : i) = pprTrace "tcIfaceLetBndr: discarding unexpected IdInfo" 
                                            (ppr other) (tc_info i)
 
     tc_info (other          : i) = pprTrace "tcIfaceLetBndr: discarding unexpected IdInfo" 
                                            (ppr other) (tc_info i)
 
@@ -1125,13 +1250,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
@@ -1144,5 +1269,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}