[project @ 2003-10-09 15:38:22 by simonpj]

Wibles

diff --git a/ghc/compiler/iface/IfaceEnv.lhs b/ghc/compiler/iface/IfaceEnv.lhs
index 4916653..0141f77 100644 (file)
--- a/ghc/compiler/iface/IfaceEnv.lhs
+++ b/ghc/compiler/iface/IfaceEnv.lhs
@@ -279,7 +279,8 @@ tcIfaceGlobal name
            Just thing -> return thing ;
            Nothing    -> 
 
-       setLclEnv () $ do
+       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) 

diff --git a/ghc/compiler/iface/IfaceType.lhs b/ghc/compiler/iface/IfaceType.lhs
index 04ca8eb..2c83155 100644 (file)
--- a/ghc/compiler/iface/IfaceType.lhs
+++ b/ghc/compiler/iface/IfaceType.lhs
@@ -342,7 +342,7 @@ toIfaceKind k
   | Just (arg,res) <- splitFunTy_maybe k 
   = IfaceFunKind (toIfaceKind arg) (toIfaceKind res)
 #ifdef DEBUG
-  | otherwise = pprPanic "toIfaceKind" (crudePprType k)
+  | otherwise = pprTrace "toIfaceKind" (crudePprType k) IfaceOpenTypeKind
 #endif
 
 ---------------------

diff --git a/ghc/compiler/iface/TcIface.lhs b/ghc/compiler/iface/TcIface.lhs
index 911f4b1..8c2653d 100644 (file)
--- a/ghc/compiler/iface/TcIface.lhs
+++ b/ghc/compiler/iface/TcIface.lhs
@@ -26,7 +26,7 @@ import Type           ( Kind, openTypeKind, liftedTypeKind,
 import TypeRep         ( Type(..), PredType(..) )
 import TyCon           ( TyCon, tyConName )
 import HscTypes                ( ExternalPackageState(..), PackageInstEnv,
-                         TyThing(..), implicitTyThings, 
+                         TyThing(..), implicitTyThings, typeEnvIds,
                          ModIface(..), ModDetails(..), InstPool, 
                          TypeEnv, mkTypeEnv, extendTypeEnvList, lookupTypeEnv,
                          DeclPool, RulePool, Pool(..), Gated, addRuleToPool )
@@ -445,10 +445,6 @@ loadImportedInsts cls tys
        ; let { (inst_pool', iface_insts) 
                    = selectInsts (eps_insts eps) cls_gate tc_gates }
 
-       ; traceTc (text "loadImportedInsts" <+> vcat [ppr cls <+> ppr tys,
-                       text "new pool" <+> ppr inst_pool',
-                       text "new insts" <+> ppr iface_insts])
-
        -- Empty => finish up rapidly, without writing to eps
        ; if null iface_insts then
                return (eps_inst_env eps)
@@ -829,7 +825,8 @@ tcPragExpr name expr
 
                -- Check for type consistency in the unfolding
     ifOptM Opt_DoCoreLinting (
-       case lintUnfolding noSrcLoc [{- in scope -}] core_expr' of
+       get_in_scope_ids                        `thenM` \ in_scope -> 
+       case lintUnfolding noSrcLoc in_scope core_expr' of
          Nothing       -> returnM ()
          Just fail_msg -> pprPanic "Iface Lint failure" (doc <+> fail_msg)
     )                          `thenM_`
@@ -837,6 +834,14 @@ tcPragExpr name expr
    returnM core_expr'  
   where
     doc = text "Unfolding of" <+> ppr name
+    get_in_scope_ids   -- Urgh; but just for linting
+       = setLclEnv () $ 
+         do    { env <- getGblEnv 
+               ; case if_rec_types env of {
+                         Nothing -> return [] ;
+                         Just (_, get_env) -> do
+               { type_env <- get_env
+               ; return (typeEnvIds type_env) }}}
 \end{code}
 
 

diff --git a/ghc/compiler/typecheck/TcRnDriver.lhs b/ghc/compiler/typecheck/TcRnDriver.lhs
index 20d0d21..480b28f 100644 (file)
--- a/ghc/compiler/typecheck/TcRnDriver.lhs
+++ b/ghc/compiler/typecheck/TcRnDriver.lhs
@@ -517,9 +517,7 @@ tcRnExtCore hsc_env (HsExtCore this_mod decls src_binds)
 
        -- Deal with the type declarations; first bring their stuff
        -- into scope, then rname them, then type check them
-   (rdr_env, imports) <- importsFromLocalDecls $
-       HsGroup { hs_tyclds = decls, hs_valds = EmptyBinds, hs_fords = [] } ;
-               -- Rather clumsy; lots of unused fields
+   (rdr_env, imports) <- importsFromLocalDecls (mkFakeGroup decls) ;
 
    updGblEnv (\gbl -> gbl { tcg_rdr_env = rdr_env `plusGlobalRdrEnv` tcg_rdr_env gbl,
                            tcg_imports = imports `plusImportAvails` tcg_imports gbl }) 
@@ -570,6 +568,12 @@ tcRnExtCore hsc_env (HsExtCore this_mod decls src_binds)
 
    return mod_guts
    }}}}
+
+mkFakeGroup decls -- Rather clumsy; lots of unused fields
+  = HsGroup {  hs_tyclds = decls,      -- This is the one we want
+               hs_valds = EmptyBinds, hs_fords = [],
+               hs_instds = [], hs_fixds = [], hs_depds = [],
+               hs_ruleds = [] }
 \end{code}