[project @ 2004-08-16 09:53:47 by simonpj]
[ghc-hetmet.git] / ghc / compiler / iface / TcIface.lhs
index 73f20cd..1d08095 100644 (file)
@@ -5,34 +5,33 @@
 
 \begin{code}
 module TcIface ( 
-       tcImportDecl, typecheckIface,
-       tcIfaceKind, loadImportedInsts, loadImportedRules,
+       tcImportDecl, typecheckIface, tcIfaceDecl, tcIfaceGlobal,
+       loadImportedInsts, loadImportedRules,
        tcExtCoreBindings
  ) where
 #include "HsVersions.h"
 
 import IfaceSyn
-import LoadIface       ( loadHomeInterface, predInstGates )
-import IfaceEnv                ( lookupIfaceTop, newGlobalBinder, lookupOrig,
+import LoadIface       ( loadHomeInterface, predInstGates, discardDeclPrags )
+import IfaceEnv                ( lookupIfaceTop, lookupIfaceExt, newGlobalBinder, lookupOrig,
                          extendIfaceIdEnv, extendIfaceTyVarEnv, newIPName,
-                         tcIfaceTyVar, tcIfaceTyCon, tcIfaceClass, tcIfaceExtId,
-                         tcIfaceDataCon, tcIfaceLclId,
+                         tcIfaceTyVar, tcIfaceLclId,
                          newIfaceName, newIfaceNames )
-import BuildTyCl       ( buildSynTyCon, buildAlgTyCon, buildDataCon, buildClass )
+import BuildTyCl       ( buildSynTyCon, buildAlgTyCon, buildDataCon, buildClass,
+                         mkAbstractTyConRhs, mkDataTyConRhs, mkNewTyConRhs )
 import TcRnMonad
-import Type            ( Kind, openTypeKind, liftedTypeKind, 
-                         unliftedTypeKind, mkArrowKind, splitTyConApp, 
-                         mkTyVarTys, mkGenTyConApp, mkTyVarTys, ThetaType )
+import Type            ( liftedTypeKind, splitTyConApp, 
+                         mkTyVarTys, mkGenTyConApp, mkTyVarTys, ThetaType, pprClassPred )
 import TypeRep         ( Type(..), PredType(..) )
 import TyCon           ( TyCon, tyConName )
-import HscTypes                ( ExternalPackageState(..), PackageInstEnv, PackageRuleBase,
-                         HscEnv, TyThing(..), implicitTyThings, typeEnvIds,
+import HscTypes                ( ExternalPackageState(..), EpsStats(..), PackageInstEnv, 
+                         HscEnv, TyThing(..), implicitTyThings, tyThingClass, tyThingTyCon, 
                          ModIface(..), ModDetails(..), InstPool, ModGuts,
-                         TypeEnv, mkTypeEnv, extendTypeEnvList, lookupTypeEnv,
-                         DeclPool, RulePool, Pool(..), Gated, addRuleToPool )
+                         TypeEnv, mkTypeEnv, extendTypeEnv, extendTypeEnvList, 
+                         lookupTypeEnv, lookupType, typeEnvIds,
+                         RulePool )
 import InstEnv         ( extendInstEnv )
 import CoreSyn
-import PprType         ( pprClassPred )
 import PprCore         ( pprIdRules )
 import Rules           ( extendRuleBaseList )
 import CoreUtils       ( exprType )
@@ -47,12 +46,13 @@ import IdInfo               ( IdInfo, CafInfo(..), WorkerInfo(..),
                          setArityInfo, setInlinePragInfo, setCafInfo, 
                          vanillaIdInfo, newStrictnessInfo )
 import Class           ( Class )
-import TyCon           ( DataConDetails(..), tyConDataCons, tyConTyVars, isTupleTyCon, mkForeignTyCon )
-import DataCon         ( dataConWorkId, dataConExistentialTyVars, dataConArgTys )
-import TysWiredIn      ( tupleCon )
+import TyCon           ( tyConDataCons, tyConTyVars, isTupleTyCon, mkForeignTyCon )
+import DataCon         ( DataCon, dataConWorkId, dataConExistentialTyVars, dataConArgTys )
+import TysWiredIn      ( intTyCon, boolTyCon, charTyCon, listTyCon, parrTyCon, 
+                         tupleTyCon, tupleCon )
 import Var             ( TyVar, mkTyVar, tyVarKind )
-import Name            ( Name, NamedThing(..), nameModuleName, nameModule, nameOccName, 
-                         isWiredInName, wiredInNameTyThing_maybe, nameParent )
+import Name            ( Name, NamedThing(..), nameModuleName, nameModule, nameOccName, nameIsLocalOrFrom, 
+                         isWiredInName, wiredInNameTyThing_maybe, nameParent, nameParent_maybe )
 import NameEnv
 import OccName         ( OccName )
 import Module          ( Module, ModuleName, moduleName )
@@ -62,6 +62,9 @@ import SrcLoc         ( noSrcLoc )
 import Util            ( zipWithEqual, dropList, equalLength, zipLazy )
 import Maybes          ( expectJust )
 import CmdLineOpts     ( DynFlag(..) )
+
+import UniqFM (sizeUFM)
+
 \end{code}
 
 This module takes
@@ -111,100 +114,33 @@ also turn out to be needed by the code that e2 expands to.
 tcImportDecl :: Name -> IfG TyThing
 -- Get the TyThing for this Name from an interface file
 tcImportDecl name
-  = do { 
-    -- Make sure the interface is loaded
-       ; let { nd_doc = ptext SLIT("Need decl for") <+> ppr name }
-       ; traceIf (nd_doc <+> char '{')         -- Brace matches the later message
-       ; loadHomeInterface nd_doc name
-
-    -- Get the real name of the thing, with a correct nameParent field.
-    -- Before the interface is loaded, we may have a non-committal 'Nothing'
-    -- in the namePareent field (made up by IfaceEnv.lookupOrig), but 
-    -- loading the interface updates the name cache.
-    -- We need the right nameParent field in getThing
-       ; real_name <- lookupOrig (nameModuleName name) (nameOccName name)
-
-    -- Get the decl out of the EPS
-       ; main_thing <- ASSERT( real_name == name )     -- Unique should not change!
-                       getThing real_name
-
-    -- Record the import in the type env, 
-    -- slurp any rules it allows in
-       ; recordImportOf main_thing
-
-       ; let { extra | getName main_thing == real_name = empty
-                     | otherwise = brackets (ptext SLIT("when seeking") <+> ppr real_name) }
-       ; traceIf (ptext SLIT(" ...imported decl for") <+> ppr main_thing <+> extra <+> char '}')
-
-
-    -- Look up the wanted Name in the type envt; it might be
-    -- one of the subordinate members of the input thing
-       ; if real_name == getName main_thing 
-         then return main_thing
-         else do
-       { eps <- getEps
-       ; return (expectJust "tcImportDecl" $
-                 lookupTypeEnv (eps_PTE eps) real_name) }}
-
-recordImportOf :: TyThing -> IfG ()
--- Update the EPS to record the import of the Thing
---   (a) augment the type environment; this is done even for wired-in 
---      things, so that we don't go through this rigmarole a second time
---   (b) slurp in any rules to maintain the invariant that any rule
---          whose gates are all in the type envt, is in eps_rule_base
-
-recordImportOf thing
-  = do         { new_things <- updateEps (\ eps -> 
-           let { new_things   = thing : implicitTyThings thing 
-               ; new_type_env = extendTypeEnvList (eps_PTE eps) new_things
-               -- NB: opportunity for a very subtle loop here!
-               -- If working out what the implicitTyThings are involves poking
-               -- any of the fork'd thunks in 'thing', then here's what happens        
-               --      * recordImportOf succeed, extending type-env with a thunk
-               --      * the next guy to pull on type-env forces the thunk
-               --      * which pokes the suspended forks
-               --      * which, to execute, need to consult type-env (to check
-               --        entirely unrelated types, perhaps)
-           }
-           in (eps { eps_PTE = new_type_env }, new_things)
-         )
-       ; traceIf (text "tcImport: extend type env" <+> ppr new_things)
-       }
-       
-getThing :: Name -> IfG TyThing
--- Find and typecheck the thing; the Name might be a "subordinate name"
--- of the "main thing" (e.g. the constructor of a data type declaration)
--- The Thing we return is the parent "main thing"
-
-getThing name
   | Just thing <- wiredInNameTyThing_maybe name
-   = return thing
-
-  | otherwise = do     -- The normal case, not wired in
-  {    -- Get the decl from the pool
-    decl <- updateEps (\ eps ->
-           let 
-               (decls', decl) = selectDecl (eps_decls eps) name
-           in
-           (eps { eps_decls = decls' }, decl))
-
-    -- Typecheck it
-    -- Side-effects EPS by faulting in any needed decls
-    -- (via nested calls to tcImportDecl)
-  ; initIfaceLcl (nameModuleName name) (tcIfaceDecl decl) }
-
-
-selectDecl :: DeclPool -> Name -> (DeclPool, IfaceDecl)
--- Use nameParent to get the parent name of the thing
-selectDecl (Pool decls_map n_in n_out) name
-   = (Pool decls' n_in (n_out+1), decl)
-   where
-     main_name = nameParent name
-     decl = case lookupNameEnv decls_map main_name of
-               Nothing   -> pprPanic "selectDecl" (ppr main_name <+> ppr name) ;
-               Just decl -> decl
-
-     decls' = delFromNameEnv decls_map main_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 })
+       ; return thing }
+
+  | otherwise
+  = do { traceIf nd_doc
+
+       -- Load the interface, which should populate the PTE
+       ; loadHomeInterface nd_doc name 
+
+       -- Now look it up again; this time we should find it
+       ; eps <- getEps 
+       ; 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
+    }
+  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")])
 \end{code}
 
 %************************************************************************
@@ -225,11 +161,23 @@ and even if they were, the type decls might be mutually recursive.
 typecheckIface :: HscEnv
               -> ModIface      -- Get the decls from here
               -> IO ModDetails
-typecheckIface hsc_env iface@(ModIface { mi_module = mod, mi_decls = ver_decls,
-                                        mi_rules = rules, mi_insts = dfuns })
+typecheckIface hsc_env iface
   = initIfaceTc hsc_env iface $ \ tc_env_var -> do
-       {       -- Typecheck the decls
-         names <- mappM (lookupOrig (moduleName mod) . ifName) decls
+       {       -- 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,
@@ -245,14 +193,12 @@ typecheckIface hsc_env iface@(ModIface { mi_module = mod, mi_decls = ver_decls,
        ; writeMutVar tc_env_var type_env
 
                -- Now do those rules and instances
-       ; dfuns <- mapM tcIfaceInst (mi_insts iface)
-       ; rules <- mapM tcIfaceRule (mi_rules iface)
+       ; dfuns <- mapM tcIfaceInst dfuns
+       ; rules <- mapM tcIfaceRule rules
 
                -- Finished
        ; return (ModDetails { md_types = type_env, md_insts = dfuns, md_rules = rules }) 
     }
-  where
-    decls = map snd ver_decls
 \end{code}
 
 
@@ -315,7 +261,7 @@ tcIfaceDecl (IfaceId {ifName = occ_name, ifType = iface_type, ifIdInfo = info})
        ; info <- tcIdInfo name ty info
        ; return (AnId (mkVanillaGlobal name ty info)) }
 
-tcIfaceDecl (IfaceData {ifND = new_or_data, ifName = occ_name, 
+tcIfaceDecl (IfaceData {ifName = occ_name, 
                        ifTyVars = tv_bndrs, ifCtxt = rdr_ctxt,
                        ifCons = rdr_cons, 
                        ifVrcs = arg_vrcs, ifRec = is_rec, 
@@ -338,7 +284,7 @@ tcIfaceDecl (IfaceData {ifND = new_or_data, ifName = occ_name,
 
        ; tycon <- fixM ( \ tycon -> do
            { cons <- tcIfaceDataCons tycon tyvars ctxt rdr_cons
-           ; tycon <- buildAlgTyCon new_or_data tc_name tyvars ctxt cons 
+           ; tycon <- buildAlgTyCon tc_name tyvars ctxt cons 
                            arg_vrcs is_rec want_generic
            ; return tycon
            })
@@ -384,14 +330,15 @@ tcIfaceDecl (IfaceForeign {ifName = rdr_name, ifExtName = ext_name})
        ; return (ATyCon (mkForeignTyCon name ext_name 
                                         liftedTypeKind 0 [])) }
 
-tcIfaceDataCons tycon tyvars ctxt Unknown
-  = returnM Unknown
-
-tcIfaceDataCons tycon tyvars ctxt (DataCons cs)
-  = mappM tc_con_decl cs       `thenM` \ data_cons ->
-    returnM (DataCons data_cons)
+tcIfaceDataCons tycon tyvars ctxt if_cons
+  = case if_cons of
+       IfAbstractTyCon  -> return mkAbstractTyConRhs
+       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) }
   where
-    tc_con_decl (IfaceConDecl occ ex_tvs ex_ctxt args stricts field_lbls)
+    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
@@ -402,7 +349,7 @@ tcIfaceDataCons tycon tyvars ctxt (DataCons cs)
 
        ; lbl_names <- mappM lookupIfaceTop field_lbls
 
-       ; buildDataCon name stricts lbl_names
+       ; buildDataCon name is_infix stricts lbl_names
                       tyvars ctxt ex_tyvars ex_theta 
                       arg_tys tycon
        }
@@ -441,6 +388,13 @@ 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}
 loadImportedInsts :: Class -> [Type] -> TcM PackageInstEnv
 loadImportedInsts cls tys
@@ -457,20 +411,14 @@ loadImportedInsts cls tys
        ; if null wired_tcs then returnM ()
          else initIfaceTcRn (mapM_ (loadHomeInterface wired_doc) wired_tcs)
 
-       ; eps_var <- getEpsVar
-       ; eps <- readMutVar eps_var
-
-       -- Suck in the instances
-       ; let { (inst_pool', iface_insts) 
-                   = selectInsts (eps_insts eps) cls_gate tc_gates }
+               -- 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
-               return (eps_inst_env eps)
+               do { eps <- getEps; return (eps_inst_env eps) }
          else do
-       { writeMutVar eps_var (eps {eps_insts = inst_pool'})
-
-       ; traceIf (sep [ptext SLIT("Importing instances for") <+> pprClassPred cls tys, 
+       { traceIf (sep [ptext SLIT("Importing instances for") <+> pprClassPred cls tys, 
                        nest 2 (vcat (map ppr iface_insts))])
 
        -- Typecheck the new instances
@@ -492,25 +440,36 @@ tcIfaceInst :: IfaceInst -> IfL DFunId
 tcIfaceInst (IfaceInst { ifDFun = dfun_occ })
   = tcIfaceExtId (LocalTop dfun_occ)
 
-selectInsts :: InstPool -> Name -> [Name] -> (InstPool, [(ModuleName, IfaceInst)])
-selectInsts pool@(Pool insts n_in n_out) cls tycons
-  = (Pool insts' n_in (n_out + length iface_insts), iface_insts)
+selectInsts :: Name -> [Name] -> ExternalPackageState -> (ExternalPackageState, [(ModuleName, IfaceInst)])
+selectInsts cls tycons eps
+  = (eps { eps_insts = insts', eps_stats = stats' }, iface_insts)
   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 -> 
+               Just gated_insts ->
        
-         case foldl choose ([],[]) gated_insts of {
+         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
-    choose (gis, decls) (gates, decl)
-       | any (`elem` tycons) gates = (gis,                decl:decls)
-       | otherwise                 = ((gates,decl) : gis, decls)
+    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)
 \end{code}
 
 %************************************************************************
@@ -524,13 +483,12 @@ 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}
-loadImportedRules :: HscEnv -> ModGuts -> IO PackageRuleBase
+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 (\ eps ->
-               let { (new_pool, if_rules) = selectRules (eps_rules eps) (eps_PTE eps) }
-               in (eps { eps_rules = new_pool }, if_rules) )
+         if_rules <- updateEps selectRules
 
        ; traceIf (ptext SLIT("Importing rules:") <+> vcat (map ppr if_rules))
 
@@ -550,23 +508,29 @@ loadImportedRules hsc_env guts
        -- 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 :: RulePool -> TypeEnv -> (RulePool, [(ModuleName, IfaceRule)])
+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 (Pool rules n_in n_out) type_env
-  = (Pool rules' n_in (n_out + length if_rules), if_rules)
+selectRules eps
+  = (eps { eps_rules = rules', eps_stats = stats' }, if_rules)
   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 (`elemNameEnv` type_env) gates
+         gates' = filter (not . (`elemNameEnv` type_env)) gates
 
 
 tcIfaceRule :: IfaceRule -> IfL IdCoreRule
@@ -591,13 +555,6 @@ tcIfaceRule (IfaceBuiltinRule fn_rdr core_rule)
 %************************************************************************
 
 \begin{code}
-tcIfaceKind :: IfaceKind -> Kind
-tcIfaceKind IfaceOpenTypeKind     = openTypeKind
-tcIfaceKind IfaceLiftedTypeKind   = liftedTypeKind
-tcIfaceKind IfaceUnliftedTypeKind = unliftedTypeKind
-tcIfaceKind (IfaceFunKind k1 k2)  = mkArrowKind (tcIfaceKind k1) (tcIfaceKind k2)
-
------------------------------------------
 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') }
@@ -799,10 +756,9 @@ do_one mod (IfaceRec pairs) thing_inside
 %************************************************************************
 
 \begin{code}
-tcIdInfo name ty NoInfo        = return vanillaIdInfo
-tcIdInfo name ty DiscardedInfo = return vanillaIdInfo
-tcIdInfo name ty (HasInfo iface_info)
-  = foldlM tcPrag init_info iface_info
+tcIdInfo :: Name -> Type -> IfaceIdInfo -> IfL IdInfo
+tcIdInfo name ty NoInfo                = return vanillaIdInfo
+tcIdInfo name ty (HasInfo info) = foldlM tcPrag init_info info
   where
     -- Set the CgInfo to something sensible but uninformative before
     -- we start; default assumption is that it has CAFs
@@ -828,8 +784,8 @@ tcIdInfo name ty (HasInfo iface_info)
 \end{code}
 
 \begin{code}
-tcWorkerInfo ty info wkr_name arity
-  = do         { mb_wkr_id <- forkM_maybe doc (tcIfaceExtId (LocalTop wkr_name))
+tcWorkerInfo ty info wkr arity
+  = do         { mb_wkr_id <- forkM_maybe doc (tcIfaceExtId wkr)
 
        -- We return without testing maybe_wkr_id, but as soon as info is
        -- looked at we will test it.  That's ok, because its outside the
@@ -842,7 +798,7 @@ tcWorkerInfo ty info wkr_name arity
                     Nothing     -> info
                     Just wkr_id -> add_wkr_info us wkr_id info) }
   where
-    doc = text "Worker for" <+> ppr wkr_name
+    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
@@ -853,7 +809,7 @@ tcWorkerInfo ty info wkr_name arity
        -- before worker info,  fingers crossed ....
     strict_sig = case newStrictnessInfo info of
                   Just sig -> sig
-                  Nothing  -> pprPanic "Worker info but no strictness for" (ppr wkr_name)
+                  Nothing  -> pprPanic "Worker info but no strictness for" (ppr wkr)
 \end{code}
 
 For unfoldings we try to do the job lazily, so that we never type check
@@ -890,6 +846,67 @@ tcPragExpr name expr
 
 %************************************************************************
 %*                                                                     *
+               Getting from Names to TyThings
+%*                                                                     *
+%************************************************************************
+
+\begin{code}
+tcIfaceGlobal :: Name -> IfM a TyThing
+tcIfaceGlobal name
+  = do { (eps,hpt) <- getEpsAndHpt
+       ; case lookupType hpt (eps_PTE eps) name of {
+           Just thing -> return thing ;
+           Nothing    -> 
+
+       setLclEnv () $ do       -- This gets us back to IfG, mainly to 
+                               -- pacify get_type_env; rather untidy
+       { env <- getGblEnv
+       ; case if_rec_types env of
+           Just (mod, get_type_env) 
+               | nameIsLocalOrFrom mod name
+               -> do           -- It's defined in the module being compiled
+               { type_env <- get_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
+    }}}
+
+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) }
+
+tcIfaceClass :: IfaceExtName -> IfL Class
+tcIfaceClass rdr_name = do { name <- lookupIfaceExt rdr_name
+                          ; thing <- tcIfaceGlobal name
+                          ; return (tyThingClass thing) }
+
+tcIfaceDataCon :: IfaceExtName -> IfL DataCon
+tcIfaceDataCon gbl = do { name <- lookupIfaceExt gbl
+                       ; thing <- tcIfaceGlobal name
+                       ; case thing of
+                               ADataCon dc -> return dc
+                               other   -> pprPanic "tcIfaceExtDC" (ppr gbl $$ ppr name$$ ppr thing) }
+
+tcIfaceExtId :: IfaceExtName -> IfL Id
+tcIfaceExtId gbl = do { name <- lookupIfaceExt gbl
+                     ; thing <- tcIfaceGlobal name
+                     ; case thing of
+                         AnId id -> return id
+                         other   -> pprPanic "tcIfaceExtId" (ppr gbl $$ ppr name$$ ppr thing) }
+\end{code}
+
+%************************************************************************
+%*                                                                     *
                Bindings
 %*                                                                     *
 %************************************************************************
@@ -948,5 +965,6 @@ bindIfaceTyVars bndrs thing_inside
   where
     (occs,kinds) = unzip bndrs
 
-mk_iface_tyvar name kind = mkTyVar name (tcIfaceKind kind)
+mk_iface_tyvar name kind = mkTyVar name kind
 \end{code}
+