[project @ 2002-12-05 23:49:43 by mthomas]

[ghc-hetmet.git] / ghc / compiler / typecheck / TcRnDriver.lhs

diff --git a/ghc/compiler/typecheck/TcRnDriver.lhs b/ghc/compiler/typecheck/TcRnDriver.lhs
index 1210d3c..d6ea564 100644 (file)
--- a/ghc/compiler/typecheck/TcRnDriver.lhs
+++ b/ghc/compiler/typecheck/TcRnDriver.lhs
@@ -16,7 +16,8 @@ module TcRnDriver (
 #include "HsVersions.h"
 
 #ifdef GHCI
-import {-# SOURCE #-} TcSplice( tcSpliceDecls )
+import {-# SOURCE #-} TcSplice ( tcSpliceDecls )
+import               DsMeta   ( templateHaskellNames )
 #endif
 
 import CmdLineOpts     ( DynFlag(..), opt_PprStyle_Debug, dopt )
@@ -100,7 +101,7 @@ import HscTypes             ( PersistentCompilerState(..), InteractiveContext(..),
                          ModIface, ModDetails(..), ModGuts(..),
                          HscEnv(..), 
                          ModIface(..), ModDetails(..), IfaceDecls(..),
-                         GhciMode(..), 
+                         GhciMode(..), noDependencies,
                          Deprecations(..), plusDeprecs,
                          emptyGlobalRdrEnv,
                          GenAvailInfo(Avail), availsToNameSet, 
@@ -147,7 +148,7 @@ tcRnModule hsc_env pcs
        updGblEnv ( \ gbl -> gbl { tcg_rdr_env = rdr_env,
                                   tcg_imports = tcg_imports gbl `plusImportAvails` imports }) 
                     $ do {
-       traceRn (text "rn1" <+> ppr (dep_mods imports)) ;
+       traceRn (text "rn1" <+> ppr (imp_dep_mods imports)) ;
                -- Fail if there are any errors so far
                -- The error printing (if needed) takes advantage 
                -- of the tcg_env we have now set
@@ -485,9 +486,16 @@ tcRnThing hsc_env pcs ictxt rdr_name
        do { addMessages (head msgs_s) ; failM }
     else do {
 
-    mapM_ addMessages msgs_s ; -- Add deprecation warnings
-    mapM tcLookupGlobal names  -- and lookup up the entities
-    }}
+       -- Add deprecation warnings
+    mapM_ addMessages msgs_s ; 
+
+       -- Slurp in the supporting declarations
+    tcg_env <- importSupportingDecls (mkFVs names) ;
+    setGblEnv tcg_env $ do {
+
+       -- And lookup up the entities
+    mapM tcLookupGlobal names
+    }}}
 \end{code}
 
 
@@ -556,7 +564,7 @@ tcRnExtCore hsc_env pcs
        mod_guts = ModGuts {    mg_module   = this_mod,
                                mg_usages   = [],       -- ToDo: compute usage
                                mg_dir_imps = [],       -- ??
-                               mg_deps     = ([],[]),  -- ??
+                               mg_deps     = noDependencies,   -- ??
                                mg_exports  = my_exports,
                                mg_types    = final_type_env,
                                mg_insts    = tcg_insts tcg_env,
@@ -608,7 +616,7 @@ tcRnSrcDecls ds
        (rn_splice_expr, fvs) <- initRn SourceMode $
                                 addSrcLoc splice_loc $
                                 rnExpr splice_expr ;
-       tcg_env <- importSupportingDecls fvs ;
+       tcg_env <- importSupportingDecls (fvs `plusFV` templateHaskellNames) ;
        setGblEnv tcg_env $ do {
 
        -- Execute the splice
@@ -694,7 +702,7 @@ tcTopSrcDecls rn_decls
        -- in this module, which is why the knot is so big
 
                        -- Do the main work
-       ((tcg_env, binds, rules, fords), lie) <- getLIE (
+       ((tcg_env, lcl_env, binds, rules, fords), lie) <- getLIE (
                tc_src_decls unf_env rn_decls
            ) ;
 
@@ -705,8 +713,12 @@ tcTopSrcDecls rn_decls
             -- type.  (Usually, ambiguous type variables are resolved
             -- during the generalisation step.)
         traceTc (text "Tc8") ;
-       inst_binds <- setGblEnv tcg_env (tcSimplifyTop lie) ;
+       inst_binds <- setGblEnv tcg_env $
+                     setLclTypeEnv lcl_env $
+                     tcSimplifyTop lie ;
                -- The setGblEnv exposes the instances to tcSimplifyTop
+               -- The steLclTypeEnv exposes the local Ids, so that
+               -- we get better error messages (monomorphism restriction)
 
            -- Backsubstitution.  This must be done last.
            -- Even tcSimplifyTop may do some unification.
@@ -791,7 +803,7 @@ tc_src_decls unf_env
                          cls_dm_binds   `AndMonoBinds`
                          foe_binds } ;
 
-       return (tcg_env, all_binds, src_rules, foe_decls)
+       return (tcg_env, lcl_env, all_binds, src_rules, foe_decls)
      }}}}}}}}}
 \end{code}
 
@@ -1172,8 +1184,8 @@ pprTcGblEnv (TcGblEnv { tcg_type_env = type_env,
         , ppr_insts dfun_ids
         , vcat (map ppr rules)
         , ppr_gen_tycons (typeEnvTyCons type_env)
-        , ppr (moduleEnvElts (dep_mods imports))
-        , ppr (dep_pkgs imports)]
+        , ppr (moduleEnvElts (imp_dep_mods imports))
+        , ppr (imp_dep_pkgs imports)]
 
 pprModGuts :: ModGuts -> SDoc
 pprModGuts (ModGuts { mg_types = type_env,