Do type refinement in TcIface

[ghc-hetmet.git] / ghc / compiler / iface / TcIface.lhs

diff --git a/ghc/compiler/iface/TcIface.lhs b/ghc/compiler/iface/TcIface.lhs
index 1d08095..e2a71ce 100644 (file)
--- a/ghc/compiler/iface/TcIface.lhs
+++ b/ghc/compiler/iface/TcIface.lhs
@@ -5,40 +5,38 @@
 
 \begin{code}
 module TcIface ( 
 
 \begin{code}
 module TcIface ( 

-       tcImportDecl, typecheckIface, tcIfaceDecl, tcIfaceGlobal,
-       loadImportedInsts, loadImportedRules,
+       tcImportDecl, checkWiredInTyCon, tcHiBootIface, typecheckIface, 
+       tcIfaceDecl, tcIfaceInst, tcIfaceRule, tcIfaceGlobal, 

        tcExtCoreBindings
  ) where
        tcExtCoreBindings
  ) where

+

 #include "HsVersions.h"
 
 import IfaceSyn
 #include "HsVersions.h"
 
 import IfaceSyn

-import LoadIface       ( loadHomeInterface, predInstGates, discardDeclPrags )
-import IfaceEnv                ( lookupIfaceTop, lookupIfaceExt, newGlobalBinder, lookupOrig,
+import LoadIface       ( loadInterface, loadWiredInHomeIface,
+                         loadDecls, findAndReadIface )
+import IfaceEnv                ( lookupIfaceTop, lookupIfaceExt, newGlobalBinder, 

                          extendIfaceIdEnv, extendIfaceTyVarEnv, newIPName,
                          extendIfaceIdEnv, extendIfaceTyVarEnv, newIPName,

-                         tcIfaceTyVar, tcIfaceLclId,
-                         newIfaceName, newIfaceNames )
+                         tcIfaceTyVar, tcIfaceLclId, lookupIfaceTc, refineIfaceIdEnv,
+                         newIfaceName, newIfaceNames, ifaceExportNames )

 import BuildTyCl       ( buildSynTyCon, buildAlgTyCon, buildDataCon, buildClass,
                          mkAbstractTyConRhs, mkDataTyConRhs, mkNewTyConRhs )
 import TcRnMonad
 import BuildTyCl       ( buildSynTyCon, buildAlgTyCon, buildDataCon, buildClass,
                          mkAbstractTyConRhs, mkDataTyConRhs, mkNewTyConRhs )
 import TcRnMonad

-import Type            ( liftedTypeKind, splitTyConApp, 
-                         mkTyVarTys, mkGenTyConApp, mkTyVarTys, ThetaType, pprClassPred )
+import Type            ( liftedTypeKind, splitTyConApp, mkTyConApp,
+                         mkTyVarTys, ThetaType )

 import TypeRep         ( Type(..), PredType(..) )
 import TyCon           ( TyCon, tyConName )
 import TypeRep         ( Type(..), PredType(..) )
 import TyCon           ( TyCon, tyConName )

-import HscTypes                ( ExternalPackageState(..), EpsStats(..), PackageInstEnv, 
-                         HscEnv, TyThing(..), implicitTyThings, tyThingClass, tyThingTyCon, 
-                         ModIface(..), ModDetails(..), InstPool, ModGuts,
-                         TypeEnv, mkTypeEnv, extendTypeEnv, extendTypeEnvList, 
-                         lookupTypeEnv, lookupType, typeEnvIds,
-                         RulePool )
-import InstEnv         ( extendInstEnv )
+import HscTypes                ( ExternalPackageState(..), 
+                         TyThing(..), tyThingClass, tyThingTyCon, 
+                         ModIface(..), ModDetails(..), HomeModInfo(..),
+                         emptyModDetails, lookupTypeEnv, lookupType, typeEnvIds )
+import InstEnv         ( Instance(..), mkImportedInstance )
+import Unify           ( coreRefineTys )

 import CoreSyn
 import CoreSyn

-import PprCore         ( pprIdRules )
-import Rules           ( extendRuleBaseList )

 import CoreUtils       ( exprType )
 import CoreUnfold
 import CoreLint                ( lintUnfolding )
 import WorkWrap                ( mkWrapper )
 import CoreUtils       ( exprType )
 import CoreUnfold
 import CoreLint                ( lintUnfolding )
 import WorkWrap                ( mkWrapper )

-import InstEnv         ( DFunId )

 import Id              ( Id, mkVanillaGlobal, mkLocalId )
 import MkId            ( mkFCallId )
 import IdInfo          ( IdInfo, CafInfo(..), WorkerInfo(..), 
 import Id              ( Id, mkVanillaGlobal, mkLocalId )
 import MkId            ( mkFCallId )
 import IdInfo          ( IdInfo, CafInfo(..), WorkerInfo(..), 

@@ -46,25 +44,22 @@ import IdInfo               ( IdInfo, CafInfo(..), WorkerInfo(..),
                          setArityInfo, setInlinePragInfo, setCafInfo, 
                          vanillaIdInfo, newStrictnessInfo )
 import Class           ( Class )
                          setArityInfo, setInlinePragInfo, setCafInfo, 
                          vanillaIdInfo, newStrictnessInfo )
 import Class           ( Class )

-import TyCon           ( tyConDataCons, tyConTyVars, isTupleTyCon, mkForeignTyCon )
-import DataCon         ( DataCon, dataConWorkId, dataConExistentialTyVars, dataConArgTys )
-import TysWiredIn      ( intTyCon, boolTyCon, charTyCon, listTyCon, parrTyCon, 
-                         tupleTyCon, tupleCon )
+import TyCon           ( tyConDataCons, isTupleTyCon, mkForeignTyCon )
+import DataCon         ( DataCon, dataConWorkId, dataConTyVars, dataConInstArgTys, isVanillaDataCon )
+import TysWiredIn      ( tupleCon, tupleTyCon, listTyCon, intTyCon, boolTyCon, charTyCon, parrTyCon )

 import Var             ( TyVar, mkTyVar, tyVarKind )
 import Var             ( TyVar, mkTyVar, tyVarKind )

-import Name            ( Name, NamedThing(..), nameModuleName, nameModule, nameOccName, nameIsLocalOrFrom, 
-                         isWiredInName, wiredInNameTyThing_maybe, nameParent, nameParent_maybe )
+import Name            ( Name, nameModule, nameIsLocalOrFrom, isWiredInName,
+                         wiredInNameTyThing_maybe, nameParent )

 import NameEnv
 import OccName         ( OccName )
 import NameEnv
 import OccName         ( OccName )

-import Module          ( Module, ModuleName, moduleName )
+import Module          ( Module, lookupModuleEnv )

 import UniqSupply      ( initUs_ )
 import Outputable      
 import UniqSupply      ( initUs_ )
 import Outputable      

+import ErrUtils                ( Message )
+import Maybes          ( MaybeErr(..) )

 import SrcLoc          ( noSrcLoc )
 import SrcLoc          ( noSrcLoc )

-import Util            ( zipWithEqual, dropList, equalLength, zipLazy )
-import Maybes          ( expectJust )
-import CmdLineOpts     ( DynFlag(..) )
-
-import UniqFM (sizeUFM)
-
+import Util            ( zipWithEqual, dropList, equalLength )
+import DynFlags                ( DynFlag(..), isOneShot )

 \end{code}
 
 This module takes
 \end{code}
 
 This module takes

@@ -111,36 +106,62 @@ where the code that e1 expands to might import some defns that
 also turn out to be needed by the code that e2 expands to.
 
 \begin{code}
 also turn out to be needed by the code that e2 expands to.
 
 \begin{code}

-tcImportDecl :: Name -> IfG TyThing
--- Get the TyThing for this Name from an interface file
-tcImportDecl name
+tcImportDecl :: Name -> TcM TyThing
+-- Entry point for *source-code* uses of importDecl
+tcImportDecl name 

   | Just thing <- wiredInNameTyThing_maybe name
   | Just thing <- wiredInNameTyThing_maybe name

-       -- This case only happens for tuples, because we pre-populate the eps_PTE
-       -- with other wired-in things.  We can't do that for tuples because we
-       -- don't know how many of them we'll find
-  = do         { updateEps_ (\ eps -> eps { eps_PTE = extendTypeEnv (eps_PTE eps) thing })
+  = do { initIfaceTcRn (loadWiredInHomeIface name) 

        ; return thing }
        ; return thing }

-

   | otherwise
   | otherwise

-  = do { traceIf nd_doc
+  = do         { traceIf (text "tcImportDecl" <+> ppr name)
+       ; mb_thing <- initIfaceTcRn (importDecl name)
+       ; case mb_thing of
+           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. 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
+       ; if nameIsLocalOrFrom mod tc_name then
+               -- Don't look for (non-existent) Float.hi when
+               -- compiling Float.lhs, which mentions Float of course
+               return ()
+         else  -- A bit yukky to call initIfaceTcRn here
+               initIfaceTcRn (loadWiredInHomeIface tc_name) 
+       }
+  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
+  = ASSERT( not (isWiredInName name) )
+    do { traceIf nd_doc

 
        -- Load the interface, which should populate the PTE
 
        -- Load the interface, which should populate the PTE

-       ; loadHomeInterface nd_doc name 
+       ; mb_iface <- loadInterface nd_doc (nameModule name) ImportBySystem
+       ; case mb_iface of {
+               Failed err_msg  -> return (Failed err_msg) ;
+               Succeeded iface -> do

 
        -- Now look it up again; this time we should find it
 
        -- Now look it up again; this time we should find it

-       ; eps <- getEps 
+       { eps <- getEps 

        ; case lookupTypeEnv (eps_PTE eps) name of
        ; case lookupTypeEnv (eps_PTE eps) name of

-           Just thing -> return thing
-           Nothing    -> do { ioToIOEnv (printErrs (msg defaultErrStyle)); failM }
-                               -- Declaration not found!
-                               -- No errors-var to accumulate errors in, so just
-                               -- print out the error right now
-    }
+           Just thing -> return (Succeeded thing)
+           Nothing    -> return (Failed not_found_msg)
+    }}}

   where
     nd_doc = ptext SLIT("Need decl for") <+> ppr name
   where
     nd_doc = ptext SLIT("Need decl for") <+> ppr name

-    msg = hang (ptext SLIT("Can't find interface-file declaration for") <+> ppr (nameParent 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")])
+    not_found_msg = hang (ptext SLIT("Can't find interface-file declaration for") <+> ppr (nameParent 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}
 
 %************************************************************************
 \end{code}
 
 %************************************************************************

@@ -158,46 +179,41 @@ knot.  Remember, the decls aren't necessarily in dependency order --
 and even if they were, the type decls might be mutually recursive.
 
 \begin{code}
 and even if they were, the type decls might be mutually recursive.
 
 \begin{code}

-typecheckIface :: HscEnv
-              -> ModIface      -- Get the decls from here
-              -> IO ModDetails
-typecheckIface hsc_env iface
-  = initIfaceTc hsc_env iface $ \ tc_env_var -> do
+typecheckIface :: ModIface     -- Get the decls from here
+              -> TcRnIf gbl lcl ModDetails
+typecheckIface iface
+  = initIfaceTc iface $ \ tc_env_var -> do
+       -- The tc_env_var is freshly allocated, private to 
+       -- type-checking this particular interface

        {       -- Get the right set of decls and rules.  If we are compiling without -O
                -- we discard pragmas before typechecking, so that we don't "see"
                -- information that we shouldn't.  From a versioning point of view
                -- It's not actually *wrong* to do so, but in fact GHCi is unable 
                -- to handle unboxed tuples, so it must not see unfoldings.
          ignore_prags <- doptM Opt_IgnoreInterfacePragmas
        {       -- Get the right set of decls and rules.  If we are compiling without -O
                -- we discard pragmas before typechecking, so that we don't "see"
                -- information that we shouldn't.  From a versioning point of view
                -- It's not actually *wrong* to do so, but in fact GHCi is unable 
                -- to handle unboxed tuples, so it must not see unfoldings.
          ignore_prags <- doptM Opt_IgnoreInterfacePragmas

-       ; let { decls | ignore_prags = map (discardDeclPrags . snd) (mi_decls iface)
-                     | otherwise    = map snd (mi_decls iface)
-             ; rules | ignore_prags = []
-                     | otherwise    = mi_rules iface
-             ; dfuns    = mi_insts iface
-             ; mod_name = moduleName (mi_module iface)
-         }
-               -- Typecheck the decls
-       ; names <- mappM (lookupOrig mod_name . ifName) decls
-       ; ty_things <- fixM (\ rec_ty_things -> do
-               { writeMutVar tc_env_var (mkNameEnv (names `zipLazy` rec_ty_things))
-                       -- This only makes available the "main" things,
-                       -- but that's enough for the strictly-checked part
-               ; mapM tcIfaceDecl decls })
-       
-               -- Now augment the type envt with all the implicit things
-               -- These will be needed when type-checking the unfoldings for
-               -- the IfaceIds, but this is done lazily, so writing the thing
-               -- now is sufficient
-       ; let   { add_implicits main_thing = main_thing : implicitTyThings main_thing
-               ; type_env = mkTypeEnv (concatMap add_implicits ty_things) }
+
+               -- Load & typecheck the decls
+       ; decl_things <- loadDecls ignore_prags (mi_decls iface)
+
+       ; let type_env = mkNameEnv decl_things

        ; writeMutVar tc_env_var type_env
 
                -- Now do those rules and instances
        ; writeMutVar tc_env_var type_env
 
                -- Now do those rules and instances

+       ; let { rules | ignore_prags = []
+                     | otherwise    = mi_rules iface
+             ; dfuns = mi_insts iface
+             } 

        ; dfuns <- mapM tcIfaceInst dfuns
        ; rules <- mapM tcIfaceRule rules
 
        ; dfuns <- mapM tcIfaceInst dfuns
        ; rules <- mapM tcIfaceRule rules
 

+               -- Exports
+       ; exports <-  ifaceExportNames (mi_exports iface)
+

                -- Finished
                -- Finished

-       ; return (ModDetails { md_types = type_env, md_insts = dfuns, md_rules = rules }) 
+       ; return (ModDetails {  md_types = type_env, 
+                               md_insts = dfuns,
+                               md_rules = rules,
+                               md_exports = exports }) 

     }
 \end{code}
 
     }
 \end{code}
 

@@ -208,6 +224,74 @@ typecheckIface hsc_env iface
 %*                                                                     *
 %************************************************************************
 
 %*                                                                     *
 %************************************************************************
 

+\begin{code}
+tcHiBootIface :: Module -> TcRn ModDetails
+-- Load the hi-boot iface for the module being compiled,
+-- if it indeed exists in the transitive closure of imports
+-- Return the ModDetails, empty if no hi-boot iface
+tcHiBootIface mod
+  = do         { traceIf (text "loadHiBootInterface" <+> ppr mod)
+
+       ; mode <- getGhciMode
+       ; if not (isOneShot mode)
+               -- In --make and interactive mode, if this module has an hs-boot file
+               -- we'll have compiled it already, and it'll be in the HPT
+               -- 
+               -- We check wheher the interface is a *boot* interface.
+               -- It can happen (when using GHC from Visual Studio) that we
+               -- compile a module in TypecheckOnly mode, with a stable, 
+               -- fully-populated HPT.  In that case the boot interface isn't there
+               -- (it's been replaced by the mother module) so we can't check it.
+               -- And that's fine, because if M's ModInfo is in the HPT, then 
+               -- it's been compiled once, and we don't need to check the boot iface
+         then do { hpt <- getHpt
+                 ; case lookupModuleEnv hpt mod of
+                     Just info | mi_boot (hm_iface info) 
+                               -> return (hm_details info)
+                     other -> return emptyModDetails }
+         else do
+
+       -- OK, so we're in one-shot mode.  
+       -- In that case, we're read all the direct imports by now, 
+       -- so eps_is_boot will record if any of our imports mention us by 
+       -- way of hi-boot file
+       { eps <- getEps
+       ; case lookupModuleEnv (eps_is_boot eps) mod of {
+           Nothing -> return emptyModDetails ; -- The typical case
+
+           Just (_, False) -> failWithTc moduleLoop ;
+               -- Someone below us imported us!
+               -- This is a loop with no hi-boot in the way
+               
+           Just (mod, True) ->         -- There's a hi-boot interface below us
+               
+    do { read_result <- findAndReadIface 
+                               True    -- Explicit import? 
+                               need mod
+                               True    -- Hi-boot file
+
+       ; case read_result of
+               Failed err               -> failWithTc (elaborate err)
+               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")
+
+    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") <+> 
+                         quotes (ppr mod) <> colon) 4 err
+\end{code}
+
+
+%************************************************************************
+%*                                                                     *
+               Type and class declarations
+%*                                                                     *
+%************************************************************************
+

 When typechecking a data type decl, we *lazily* (via forkM) typecheck
 the constructor argument types.  This is in the hope that we may never
 poke on those argument types, and hence may never need to load the
 When typechecking a data type decl, we *lazily* (via forkM) typecheck
 the constructor argument types.  This is in the hope that we may never
 poke on those argument types, and hence may never need to load the

@@ -262,35 +346,23 @@ tcIfaceDecl (IfaceId {ifName = occ_name, ifType = iface_type, ifIdInfo = info})
        ; return (AnId (mkVanillaGlobal name ty info)) }
 
 tcIfaceDecl (IfaceData {ifName = occ_name, 
        ; return (AnId (mkVanillaGlobal name ty info)) }
 
 tcIfaceDecl (IfaceData {ifName = occ_name, 

-                       ifTyVars = tv_bndrs, ifCtxt = rdr_ctxt,
+                       ifTyVars = tv_bndrs, 
+                       ifCtxt = ctxt,

                        ifCons = rdr_cons, 
                        ifVrcs = arg_vrcs, ifRec = is_rec, 
                        ifGeneric = want_generic })
   = do { tc_name <- lookupIfaceTop occ_name
        ; bindIfaceTyVars tv_bndrs $ \ tyvars -> do
 
                        ifCons = rdr_cons, 
                        ifVrcs = arg_vrcs, ifRec = is_rec, 
                        ifGeneric = want_generic })
   = do { tc_name <- lookupIfaceTop occ_name
        ; bindIfaceTyVars tv_bndrs $ \ tyvars -> do
 

-       { traceIf (text "tcIfaceDecl" <+> ppr rdr_ctxt)
-
-       ; ctxt <- forkM (ptext SLIT("Ctxt of data decl") <+> ppr tc_name) $
-                    tcIfaceCtxt rdr_ctxt
-               -- The reason for laziness here is to postpone
-               -- looking at the context, because the class may not
-               -- be in the type envt yet.  E.g. 
-               --      class Real a where { toRat :: a -> Ratio Integer }
-               --      data (Real a) => Ratio a = ...
-               -- We suck in the decl for Real, and type check it, which sucks
-               -- in the data type Ratio; but we must postpone typechecking the
-               -- context
-
-       ; tycon <- fixM ( \ tycon -> do
-           { cons <- tcIfaceDataCons tycon tyvars ctxt rdr_cons
-           ; tycon <- buildAlgTyCon tc_name tyvars ctxt cons 
-                           arg_vrcs is_rec want_generic
-           ; return tycon
+       { tycon <- fixM ( \ tycon -> do
+           { stupid_theta <- tcIfaceCtxt ctxt
+           ; cons  <- tcIfaceDataCons tycon tyvars rdr_cons
+           ; buildAlgTyCon tc_name tyvars stupid_theta
+                           cons arg_vrcs is_rec want_generic

            })
         ; traceIf (text "tcIfaceDecl4" <+> ppr tycon)
        ; return (ATyCon tycon)
            })
         ; traceIf (text "tcIfaceDecl4" <+> ppr tycon)
        ; return (ATyCon tycon)

-    } }
+    }}

 
 tcIfaceDecl (IfaceSyn {ifName = occ_name, ifTyVars = tv_bndrs, 
                       ifSynRhs = rdr_rhs_ty, ifVrcs = arg_vrcs})
 
 tcIfaceDecl (IfaceSyn {ifName = occ_name, ifTyVars = tv_bndrs, 
                       ifSynRhs = rdr_rhs_ty, ifVrcs = arg_vrcs})

@@ -330,30 +402,54 @@ tcIfaceDecl (IfaceForeign {ifName = rdr_name, ifExtName = ext_name})
        ; return (ATyCon (mkForeignTyCon name ext_name 
                                         liftedTypeKind 0 [])) }
 
        ; return (ATyCon (mkForeignTyCon name ext_name 
                                         liftedTypeKind 0 [])) }
 

-tcIfaceDataCons tycon tyvars ctxt if_cons
+tcIfaceDataCons tycon tc_tyvars if_cons

   = case if_cons of
   = case if_cons of

-       IfAbstractTyCon  -> return mkAbstractTyConRhs
+       IfAbstractTyCon  -> return mkAbstractTyConRhs

        IfDataTyCon cons -> do  { data_cons <- mappM tc_con_decl cons
                                ; return (mkDataTyConRhs data_cons) }
        IfDataTyCon cons -> do  { data_cons <- mappM tc_con_decl cons
                                ; return (mkDataTyConRhs data_cons) }

-       IfNewTyCon con   -> do  { data_con <- tc_con_decl con
-                               ; return (mkNewTyConRhs data_con) }
+       IfNewTyCon con   -> do  { data_con <- tc_con_decl con
+                               ; return (mkNewTyConRhs tycon data_con) }

   where
   where

-    tc_con_decl (IfaceConDecl occ is_infix ex_tvs ex_ctxt args stricts field_lbls)
-      = bindIfaceTyVars ex_tvs $ \ ex_tyvars -> do
-       { name <- lookupIfaceTop occ
-       ; ex_theta <- tcIfaceCtxt ex_ctxt       -- Laziness seems not worth the bother here
+    tc_con_decl (IfVanillaCon {        ifConOcc = occ, ifConInfix = is_infix, ifConArgTys = args, 
+                               ifConStricts = stricts, ifConFields = field_lbls})
+      = do { name  <- lookupIfaceTop occ
+               -- 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
+          ; buildDataCon name is_infix True {- Vanilla -} 
+                         stricts lbl_names
+                         tc_tyvars [] arg_tys tycon
+                         (mkTyVarTys tc_tyvars)        -- Vanilla => we know result tys
+          }  
+
+    tc_con_decl (IfGadtCon {   ifConTyVars = con_tvs,
+                               ifConOcc = occ, ifConCtxt = ctxt, 
+                               ifConArgTys = args, ifConResTys = ress, 
+                               ifConStricts = stricts})
+      = bindIfaceTyVars con_tvs        $ \ con_tyvars -> do
+       { name  <- lookupIfaceTop occ
+       ; theta <- tcIfaceCtxt ctxt     -- Laziness seems not worth the bother here
+               -- At one stage I thought that this context checking *had*
+               -- to be lazy, because of possible mutual recursion between the
+               -- type and the classe: 
+               -- E.g. 
+               --      class Real a where { toRat :: a -> Ratio Integer }
+               --      data (Real a) => Ratio a = ...
+               -- But now I think that the laziness in checking class ops breaks 
+               -- the loop, so no laziness needed

 
        -- 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 args) (mappM tcIfaceType args) ;
+       ; arg_tys <- forkM (mk_doc name) (mappM tcIfaceType args)
+       ; res_tys <- forkM (mk_doc name) (mappM tcIfaceType ress)

 
 

-       ; lbl_names <- mappM lookupIfaceTop field_lbls
-
-       ; buildDataCon name is_infix stricts lbl_names
-                      tyvars ctxt ex_tyvars ex_theta 
-                      arg_tys tycon
+       ; buildDataCon name False {- Not infix -} False {- Not vanilla -}
+                      stricts [{- No fields -}]
+                      con_tyvars theta 
+                      arg_tys tycon res_tys

        }
        }

-    mk_doc con_name args = ptext SLIT("Constructor") <+> sep [ppr con_name, ppr args]
+    mk_doc con_name = ptext SLIT("Constructor") <+> ppr con_name

 \end{code}     
 
 
 \end{code}     
 
 

@@ -363,115 +459,22 @@ tcIfaceDataCons tycon tyvars ctxt if_cons
 %*                                                                     *
 %************************************************************************
 
 %*                                                                     *
 %************************************************************************
 

-The gating story for instance declarations
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-When we are looking for a dict (C t1..tn), we slurp in instance decls for
-C that 
-       mention at least one of the type constructors 
-       at the roots of t1..tn
-
-Why "at least one" rather than "all"?  Because functional dependencies 
-complicate the picture.  Consider
-       class C a b | a->b where ...
-       instance C Foo Baz where ...
-Here, the gates are really only C and Foo, *not* Baz.
-That is, if C and Foo are visible, even if Baz isn't, we must
-slurp the decl, even if Baz is thus far completely unknown to the
-system.
-
-Why "roots of the types"?  Reason is overlap.  For example, suppose there 
-are interfaces in the pool for
-  (a)  C Int b
- (b)   C a [b]
-  (c)  C a [T] 
-Then, if we are trying to resolve (C Int x), we need (a)
-if we are trying to resolve (C x [y]), we need *both* (b) and (c),
-even though T is not involved yet, so that we spot the overlap.
-
-
-NOTE: if you use an instance decl with NO type constructors
-       instance C a where ...
-and look up an Inst that only has type variables such as (C (n o))
-then GHC won't necessarily suck in the instances that overlap with this.
-
-

 \begin{code}
 \begin{code}

-loadImportedInsts :: Class -> [Type] -> TcM PackageInstEnv
-loadImportedInsts cls tys
-  = do {       -- Get interfaces for wired-in things, such as Integer
-               -- Any non-wired-in tycons will already be loaded, else
-               -- we couldn't have them in the Type
-       ; this_mod <- getModule 
-       ; let { (cls_gate, tc_gates) = predInstGates cls tys
-             ; imp_wi n = isWiredInName n && this_mod /= nameModule n
-             ; wired_tcs = filter imp_wi tc_gates }
-                       -- Wired-in tycons not from this module.  The "this-module"
-                       -- test bites only when compiling Base etc, because loadHomeInterface
-                       -- barfs if it's asked to load a non-existent interface
-       ; if null wired_tcs then returnM ()
-         else initIfaceTcRn (mapM_ (loadHomeInterface wired_doc) wired_tcs)
-
-               -- Now suck in the relevant instances
-       ; iface_insts <- updateEps (selectInsts cls_gate tc_gates)
-
-       -- Empty => finish up rapidly, without writing to eps
-       ; if null iface_insts then
-               do { eps <- getEps; return (eps_inst_env eps) }
-         else do
-       { traceIf (sep [ptext SLIT("Importing instances for") <+> pprClassPred cls tys, 
-                       nest 2 (vcat (map ppr iface_insts))])
-
-       -- Typecheck the new instances
-       ; dfuns <- initIfaceTcRn (mappM tc_inst iface_insts)
-
-       -- And put them in the package instance environment
-       ; updateEps ( \ eps ->
-           let 
-               inst_env' = foldl extendInstEnv (eps_inst_env eps) dfuns
-           in
-           (eps { eps_inst_env = inst_env' }, inst_env')
-       )}}
-  where
-    wired_doc = ptext SLIT("Need home inteface for wired-in thing")
-
-tc_inst (mod, inst) = initIfaceLcl mod (tcIfaceInst inst)
-
-tcIfaceInst :: IfaceInst -> IfL DFunId
-tcIfaceInst (IfaceInst { ifDFun = dfun_occ })
-  = tcIfaceExtId (LocalTop dfun_occ)
-
-selectInsts :: Name -> [Name] -> ExternalPackageState -> (ExternalPackageState, [(ModuleName, IfaceInst)])
-selectInsts cls tycons eps
-  = (eps { eps_insts = insts', eps_stats = stats' }, iface_insts)
+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) $
+                    tcIfaceExtId (LocalTop dfun_occ)
+       ; cls'    <- lookupIfaceExt cls
+       ; mb_tcs' <- mapM do_tc mb_tcs
+       ; return (mkImportedInstance cls' mb_tcs' orph dfun oflag) }

   where
   where

-    insts  = eps_insts eps
-    stats  = eps_stats eps
-    stats' = stats { n_insts_out = n_insts_out stats + length iface_insts } 
-
-    (insts', iface_insts) 
-       = case lookupNameEnv insts cls of {
-               Nothing -> (insts, []) ;
-               Just gated_insts ->
-       
-         case choose1 gated_insts  of {
-           (_, []) -> (insts, []) ;    -- None picked
-           (gated_insts', iface_insts') -> 
-
-         (extendNameEnv insts cls gated_insts', iface_insts') }}
-
-    choose1 gated_insts
-       | null tycons                   -- Bizarre special case of C (a b); then there are no tycons
-       = ([], map snd gated_insts)     -- Just grab all the instances, no real alternative
-       | otherwise                     -- Normal case
-       = foldl choose2 ([],[]) gated_insts
-
-       -- Reverses the gated decls, but that doesn't matter
-    choose2 (gis, decls) (gates, decl)
-       |  null gates   -- Happens when we have 'instance T a where ...'
-        || any (`elem` tycons) gates = (gis,              decl:decls)
-       | otherwise                  = ((gates,decl) : gis, decls)
+    do_tc Nothing   = return Nothing
+    do_tc (Just tc) = do { tc' <- lookupIfaceTc tc; return (Just tc') }

 \end{code}
 
 \end{code}
 

+

 %************************************************************************
 %*                                                                     *
                Rules
 %************************************************************************
 %*                                                                     *
                Rules

@@ -483,68 +486,40 @@ are in the type environment.  However, remember that typechecking a Rule may
 (as a side effect) augment the type envt, and so we may need to iterate the process.
 
 \begin{code}
 (as a side effect) augment the type envt, and so we may need to iterate the process.
 
 \begin{code}

-loadImportedRules :: HscEnv -> ModGuts -> IO [IdCoreRule]
--- Returns just the new rules added
-loadImportedRules hsc_env guts
-  = initIfaceRules hsc_env guts $ do 
-       { -- Get new rules
-         if_rules <- updateEps selectRules
-
-       ; traceIf (ptext SLIT("Importing rules:") <+> vcat (map ppr if_rules))
-
-       ; let tc_rule (mod, rule) = initIfaceLcl mod (tcIfaceRule rule)
-       ; core_rules <- mapM tc_rule if_rules
-
-       -- Debug print
-       ; traceIf (ptext SLIT("Imported rules:") <+> pprIdRules core_rules)
-       
-       -- Update the rule base and return it
-       ; updateEps (\ eps -> 
-           let { new_rule_base = extendRuleBaseList (eps_rule_base eps) core_rules }
-           in (eps { eps_rule_base = new_rule_base }, new_rule_base)
-         ) 
-
-       -- Strictly speaking, at this point we should go round again, since
-       -- typechecking one set of rules may bring in new things which enable
-       -- some more rules to come in.  But we call loadImportedRules several
-       -- times anyway, so I'm going to be lazy and ignore this.
-       ; return core_rules
-    }
-
-
-selectRules :: ExternalPackageState -> (ExternalPackageState, [(ModuleName, IfaceRule)])
--- Not terribly efficient.  Look at each rule in the pool to see if
--- all its gates are in the type env.  If so, take it out of the pool.
--- If not, trim its gates for next time.
-selectRules eps
-  = (eps { eps_rules = rules', eps_stats = stats' }, if_rules)
+tcIfaceRule :: IfaceRule -> IfL CoreRule
+tcIfaceRule (IfaceRule {ifRuleName = name, ifActivation = act, ifRuleBndrs = bndrs,
+                       ifRuleHead = fn, ifRuleArgs = args, ifRuleRhs = rhs,
+                       ifRuleOrph = orph })
+  = do { fn' <- lookupIfaceExt fn
+       ; ~(bndrs', args', rhs') <- 
+               -- Typecheck the payload lazily, in the hope it'll never be looked at
+               forkM (ptext SLIT("Rule") <+> ftext name) $
+               bindIfaceBndrs bndrs                      $ \ bndrs' ->
+               do { args' <- mappM tcIfaceExpr args
+                  ; rhs'  <- tcIfaceExpr rhs
+                  ; return (bndrs', args', rhs') }
+       ; mb_tcs <- mapM ifTopFreeName args
+       ; returnM (Rule { ru_name = name, ru_fn = fn', ru_act = act, 
+                         ru_bndrs = bndrs', ru_args = args', 
+                         ru_rhs = rhs', ru_orph = orph,
+                         ru_rough = mb_tcs,
+                         ru_local = isLocalIfaceExtName fn }) }

   where
   where

-    stats    = eps_stats eps
-    rules    = eps_rules eps
-    type_env = eps_PTE eps
-    stats'   = stats { n_rules_out = n_rules_out stats + length if_rules }
-
-    (rules', if_rules) = foldl do_one ([], []) rules
-
-    do_one (pool, if_rules) (gates, rule)
-       | null gates' = (pool, rule:if_rules)
-       | otherwise   = ((gates',rule) : pool, if_rules)
-       where
-         gates' = filter (not . (`elemNameEnv` type_env)) gates
-
-
-tcIfaceRule :: IfaceRule -> IfL IdCoreRule
-tcIfaceRule (IfaceRule {ifRuleName = rule_name, ifActivation = act, ifRuleBndrs = bndrs,
-                       ifRuleHead = fn_rdr, ifRuleArgs = args, ifRuleRhs = rhs })
-  = bindIfaceBndrs bndrs       $ \ bndrs' ->
-    do { fn <- tcIfaceExtId fn_rdr
-       ; args' <- mappM tcIfaceExpr args
-       ; rhs'  <- tcIfaceExpr rhs
-       ; returnM (fn, (Rule rule_name act bndrs' args' rhs')) }
-
-tcIfaceRule (IfaceBuiltinRule fn_rdr core_rule)
-  = do { fn <- tcIfaceExtId fn_rdr
-       ; returnM (fn, core_rule) }
+       -- This function *must* mirror exactly what Rules.topFreeName does
+       -- We could have stored the ru_rough field in the iface file
+       -- but that would be redundant, I think.
+       -- The only wrinkle is that we must not be deceived by
+       -- type syononyms at the top of a type arg.  Since
+       -- we can't tell at this point, we are careful not
+       -- to write them out in coreRuleToIfaceRule
+    ifTopFreeName :: IfaceExpr -> IfL (Maybe Name)
+    ifTopFreeName (IfaceType (IfaceTyConApp tc _ ))
+       = do { n <- lookupIfaceTc tc
+            ; return (Just n) }
+    ifTopFreeName (IfaceApp f a) = ifTopFreeName f
+    ifTopFreeName (IfaceExt ext) = do { n <- lookupIfaceExt ext
+                                     ; return (Just n) }
+    ifTopFreeName other = return Nothing

 \end{code}
 
 
 \end{code}
 
 

@@ -559,7 +534,7 @@ tcIfaceType :: IfaceType -> IfL Type
 tcIfaceType (IfaceTyVar n)        = do { tv <- tcIfaceTyVar n; return (TyVarTy tv) }
 tcIfaceType (IfaceAppTy t1 t2)    = do { t1' <- tcIfaceType t1; t2' <- tcIfaceType t2; return (AppTy t1' t2') }
 tcIfaceType (IfaceFunTy t1 t2)    = do { t1' <- tcIfaceType t1; t2' <- tcIfaceType t2; return (FunTy t1' t2') }
 tcIfaceType (IfaceTyVar n)        = do { tv <- tcIfaceTyVar n; return (TyVarTy tv) }
 tcIfaceType (IfaceAppTy t1 t2)    = do { t1' <- tcIfaceType t1; t2' <- tcIfaceType t2; return (AppTy t1' t2') }
 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 (mkGenTyConApp tc' ts') }
+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 (IfaceForAllTy tv t)  = bindIfaceTyVar tv $ \ tv' -> do { t' <- tcIfaceType t; return (ForAllTy tv' t') }
 tcIfaceType (IfacePredTy st)      = do { st' <- tcIfacePredType st; return (PredTy st') }
 

@@ -626,7 +601,7 @@ tcIfaceExpr (IfaceApp fun arg)
     tcIfaceExpr arg            `thenM` \ arg' ->
     returnM (App fun' arg')
 
     tcIfaceExpr arg            `thenM` \ arg' ->
     returnM (App fun' arg')
 

-tcIfaceExpr (IfaceCase scrut case_bndr alts) 
+tcIfaceExpr (IfaceCase scrut case_bndr ty alts) 

   = tcIfaceExpr scrut          `thenM` \ scrut' ->
     newIfaceName case_bndr     `thenM` \ case_bndr_name ->
     let
   = tcIfaceExpr scrut          `thenM` \ scrut' ->
     newIfaceName case_bndr     `thenM` \ case_bndr_name ->
     let

@@ -641,7 +616,8 @@ tcIfaceExpr (IfaceCase scrut case_bndr alts)
     in
     extendIfaceIdEnv [case_bndr']      $
     mappM (tcIfaceAlt tc_app) alts     `thenM` \ alts' ->
     in
     extendIfaceIdEnv [case_bndr']      $
     mappM (tcIfaceAlt tc_app) alts     `thenM` \ alts' ->

-    returnM (Case scrut' case_bndr' alts')
+    tcIfaceType ty             `thenM` \ ty' ->
+    returnM (Case scrut' case_bndr' ty' alts')

 
 tcIfaceExpr (IfaceLet (IfaceNonRec bndr rhs) body)
   = tcIfaceExpr rhs            `thenM` \ rhs' ->
 
 tcIfaceExpr (IfaceLet (IfaceNonRec bndr rhs) body)
   = tcIfaceExpr rhs            `thenM` \ rhs' ->

@@ -683,63 +659,68 @@ tcIfaceAlt _ (IfaceLitAlt lit, names, rhs)
 -- 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_occs, rhs)
 -- 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_occs, rhs)

-  = let        
-       tycon_mod = nameModuleName (tyConName tycon)
-    in
-    tcIfaceDataCon (ExtPkg tycon_mod data_occ) `thenM` \ con ->
-    newIfaceNames arg_occs                     `thenM` \ arg_names ->
-    let
-       ex_tyvars   = dataConExistentialTyVars con
-       main_tyvars = tyConTyVars tycon
-       ex_tyvars'  = [mkTyVar name (tyVarKind tv) | (name,tv) <- arg_names `zip` ex_tyvars] 
-       ex_tys'     = mkTyVarTys ex_tyvars'
-       arg_tys     = dataConArgTys con (inst_tys ++ ex_tys')
-       id_names    = dropList ex_tyvars arg_names
-       arg_ids
-#ifdef DEBUG
-               | not (equalLength id_names arg_tys)
-               = pprPanic "tcIfaceAlts" (ppr (con, arg_names, rhs) $$
-                                        (ppr main_tyvars <+> ppr ex_tyvars) $$
-                                        ppr arg_tys)
-               | otherwise
-#endif
-               = zipWithEqual "tcIfaceAlts" mkLocalId id_names arg_tys
-    in
-    ASSERT2( con `elem` tyConDataCons tycon && equalLength inst_tys main_tyvars,
-            ppr con $$ ppr tycon $$ ppr (tyConDataCons tycon) $$ ppr arg_tys $$  ppr main_tyvars  )
-    extendIfaceTyVarEnv ex_tyvars'     $
-    extendIfaceIdEnv arg_ids           $
-    tcIfaceExpr rhs                    `thenM` \ rhs' ->
-    returnM (DataAlt con, ex_tyvars' ++ arg_ids, rhs')
+  = do { let tycon_mod = nameModule (tyConName tycon)
+       ; con <- tcIfaceDataCon (ExtPkg tycon_mod data_occ)
+       ; ASSERT2( con `elem` tyConDataCons tycon,
+                  ppr con $$ ppr tycon $$ ppr (tyConDataCons tycon) )
+                 
+         if isVanillaDataCon con then
+               tcVanillaAlt con inst_tys arg_occs rhs
+         else
+    do         {       -- General case
+         arg_names <- newIfaceNames arg_occs
+       ; let   tyvars   = [ mkTyVar name (tyVarKind tv) 
+                          | (name,tv) <- arg_names `zip` dataConTyVars con] 
+               arg_tys  = dataConInstArgTys con (mkTyVarTys tyvars)
+               id_names = dropList tyvars arg_names
+               arg_ids  = ASSERT2( equalLength id_names arg_tys,
+                                   ppr (con, arg_names, rhs) $$ ppr tyvars $$ ppr arg_tys )
+                          zipWith mkLocalId id_names arg_tys
+
+               Just refine = coreRefineTys con tyvars (mkTyConApp tycon inst_tys)
+               
+       ; rhs' <- extendIfaceTyVarEnv tyvars    $
+                 extendIfaceIdEnv arg_ids      $
+                 refineIfaceIdEnv refine       $
+                       -- You might think that we don't need to refine the envt here,
+                       -- but we do: \(x::a) -> case y of 
+                       --                           MkT -> case x of { True -> ... }
+                       -- In the "case x" we need to know x's type, because we use that
+                       -- to find which module to look for "True" in. Sigh.
+                 tcIfaceExpr rhs
+       ; return (DataAlt con, tyvars ++ arg_ids, rhs') }}

 
 tcIfaceAlt (tycon, inst_tys) (IfaceTupleAlt boxity, arg_occs, rhs)
 
 tcIfaceAlt (tycon, inst_tys) (IfaceTupleAlt boxity, arg_occs, rhs)

-  = newIfaceNames arg_occs     `thenM` \ arg_names ->
-    let
-       [con]   = tyConDataCons tycon
-       arg_ids = zipWithEqual "tcIfaceAlts" mkLocalId arg_names inst_tys
-    in
-    ASSERT( isTupleTyCon tycon )
-    extendIfaceIdEnv arg_ids           $
-    tcIfaceExpr rhs                    `thenM` \ rhs' ->
-    returnM (DataAlt con, arg_ids, rhs')
+  = ASSERT( isTupleTyCon tycon )
+    do { let [data_con] = tyConDataCons tycon
+       ; tcVanillaAlt data_con inst_tys arg_occs rhs }
+
+tcVanillaAlt data_con inst_tys arg_occs rhs
+  = do { arg_names <- newIfaceNames arg_occs
+       ; let arg_tys = dataConInstArgTys data_con inst_tys
+       ; let arg_ids = ASSERT2( equalLength arg_names arg_tys,
+                                ppr data_con <+> ppr inst_tys <+> ppr arg_occs $$ ppr rhs )
+                       zipWith mkLocalId arg_names arg_tys
+       ; rhs' <- extendIfaceIdEnv arg_ids (tcIfaceExpr rhs)
+       ; returnM (DataAlt data_con, arg_ids, rhs') }

 \end{code}
 
 
 \begin{code}
 \end{code}
 
 
 \begin{code}

-tcExtCoreBindings :: Module -> [IfaceBinding] -> IfL [CoreBind]        -- Used for external core
-tcExtCoreBindings mod []     = return []
-tcExtCoreBindings mod (b:bs) = do_one mod b (tcExtCoreBindings mod bs)
+tcExtCoreBindings :: [IfaceBinding] -> IfL [CoreBind]  -- Used for external core
+tcExtCoreBindings []     = return []
+tcExtCoreBindings (b:bs) = do_one b (tcExtCoreBindings bs)

 
 

-do_one :: Module -> IfaceBinding -> IfL [CoreBind] -> IfL [CoreBind]
-do_one mod (IfaceNonRec bndr rhs) thing_inside
+do_one :: IfaceBinding -> IfL [CoreBind] -> IfL [CoreBind]
+do_one (IfaceNonRec bndr rhs) thing_inside

   = do { rhs' <- tcIfaceExpr rhs
   = do { rhs' <- tcIfaceExpr rhs

-       ; bndr' <- newExtCoreBndr mod bndr
+       ; bndr' <- newExtCoreBndr bndr

        ; extendIfaceIdEnv [bndr'] $ do 
        { core_binds <- thing_inside
        ; return (NonRec bndr' rhs' : core_binds) }}
 
        ; extendIfaceIdEnv [bndr'] $ do 
        { core_binds <- thing_inside
        ; return (NonRec bndr' rhs' : core_binds) }}
 

-do_one mod (IfaceRec pairs) thing_inside
-  = do { bndrs' <- mappM (newExtCoreBndr mod) bndrs
+do_one (IfaceRec pairs) thing_inside
+  = do { bndrs' <- mappM newExtCoreBndr bndrs

        ; extendIfaceIdEnv bndrs' $ do
        { rhss' <- mappM tcIfaceExpr rhss
        ; core_binds <- thing_inside
        ; extendIfaceIdEnv bndrs' $ do
        { rhss' <- mappM tcIfaceExpr rhss
        ; core_binds <- thing_inside

@@ -851,39 +832,64 @@ tcPragExpr name expr
 %************************************************************************
 
 \begin{code}
 %************************************************************************
 
 \begin{code}

-tcIfaceGlobal :: Name -> IfM a TyThing
+tcIfaceGlobal :: Name -> IfL TyThing

 tcIfaceGlobal name
 tcIfaceGlobal name

+  | Just thing <- wiredInNameTyThing_maybe name
+       -- Wired-in things include TyCons, DataCons, and Ids
+  = do { loadWiredInHomeIface name; return thing }
+       -- Even though we are in an interface file, we want to make
+       -- sure its instances are loaded (imagine f :: Double -> Double)
+       -- and its RULES are loaded too
+  | otherwise

   = do { (eps,hpt) <- getEpsAndHpt
        ; case lookupType hpt (eps_PTE eps) name of {
            Just thing -> return thing ;
   = do { (eps,hpt) <- getEpsAndHpt
        ; case lookupType hpt (eps_PTE eps) name of {
            Just thing -> return thing ;

-           Nothing    -> 
+           Nothing    -> do

 
 

-       setLclEnv () $ do       -- This gets us back to IfG, mainly to 
-                               -- pacify get_type_env; rather untidy

        { env <- getGblEnv
        { env <- getGblEnv

-       ; case if_rec_types env of
+       ; case if_rec_types env of {

            Just (mod, get_type_env) 
                | nameIsLocalOrFrom mod name
                -> do           -- It's defined in the module being compiled
            Just (mod, get_type_env) 
                | nameIsLocalOrFrom mod name
                -> do           -- It's defined in the module being compiled

-               { type_env <- get_type_env
+               { type_env <- setLclEnv () get_type_env         -- yuk

                ; case lookupNameEnv type_env name of
                        Just thing -> return thing
                        Nothing    -> pprPanic "tcIfaceGlobal (local): not found:"  
                                                (ppr name $$ ppr type_env) }
 
                ; case lookupNameEnv type_env name of
                        Just thing -> return thing
                        Nothing    -> pprPanic "tcIfaceGlobal (local): not found:"  
                                                (ppr name $$ ppr type_env) }
 

-           other -> tcImportDecl name  -- It's imported; go get it
-    }}}
+         ; other -> do
+
+       { mb_thing <- importDecl name   -- It's imported; go get it
+       ; case mb_thing of
+           Failed err      -> failIfM err
+           Succeeded thing -> return thing
+    }}}}}

 
 tcIfaceTyCon :: IfaceTyCon -> IfL TyCon
 
 tcIfaceTyCon :: IfaceTyCon -> IfL TyCon

-tcIfaceTyCon IfaceIntTc  = return intTyCon
-tcIfaceTyCon IfaceBoolTc = return boolTyCon
-tcIfaceTyCon IfaceCharTc = return charTyCon
-tcIfaceTyCon IfaceListTc = return listTyCon
-tcIfaceTyCon IfacePArrTc = return parrTyCon
-tcIfaceTyCon (IfaceTupTc bx ar) = return (tupleTyCon bx ar)
-tcIfaceTyCon (IfaceTc ext_nm) = do { name <- lookupIfaceExt ext_nm
-                                  ; thing <- tcIfaceGlobal name
-                                  ; return (tyThingTyCon thing) }
+tcIfaceTyCon IfaceIntTc        = tcWiredInTyCon intTyCon
+tcIfaceTyCon IfaceBoolTc       = tcWiredInTyCon boolTyCon
+tcIfaceTyCon IfaceCharTc       = tcWiredInTyCon charTyCon
+tcIfaceTyCon IfaceListTc       = tcWiredInTyCon listTyCon
+tcIfaceTyCon IfacePArrTc       = tcWiredInTyCon parrTyCon
+tcIfaceTyCon (IfaceTupTc bx ar) = tcWiredInTyCon (tupleTyCon bx ar)
+tcIfaceTyCon (IfaceTc ext_nm)   = do { name <- lookupIfaceExt ext_nm
+                                    ; thing <- tcIfaceGlobal name 
+                                    ; return (check_tc (tyThingTyCon thing)) }
+  where
+#ifdef DEBUG
+    check_tc tc = case toIfaceTyCon (error "urk") tc of
+                  IfaceTc _ -> tc
+                  other     -> pprTrace "check_tc" (ppr tc) tc
+#else
+    check_tc tc = tc
+#endif
+
+-- Even though we are in an interface file, we want to make
+-- sure the instances and RULES of this tycon are loaded 
+-- Imagine: f :: Double -> Double
+tcWiredInTyCon :: TyCon -> IfL TyCon
+tcWiredInTyCon tc = do { loadWiredInHomeIface (tyConName tc)
+                      ; return tc }

 
 tcIfaceClass :: IfaceExtName -> IfL Class
 tcIfaceClass rdr_name = do { name <- lookupIfaceExt rdr_name
 
 tcIfaceClass :: IfaceExtName -> IfL Class
 tcIfaceClass rdr_name = do { name <- lookupIfaceExt rdr_name

@@ -944,9 +950,10 @@ bindIfaceIds bndrs thing_inside
 
 
 -----------------------
 
 
 -----------------------

-newExtCoreBndr :: Module -> (OccName, IfaceType) -> IfL Id
-newExtCoreBndr mod (occ, ty)
-  = do { name <- newGlobalBinder mod occ Nothing noSrcLoc
+newExtCoreBndr :: (OccName, IfaceType) -> IfL Id
+newExtCoreBndr (occ, ty)
+  = do { mod <- getIfModule
+       ; name <- newGlobalBinder mod occ Nothing noSrcLoc

        ; ty' <- tcIfaceType ty
        ; return (mkLocalId name ty') }
 
        ; ty' <- tcIfaceType ty
        ; return (mkLocalId name ty') }