[project @ 2002-10-24 14:17:46 by simonpj]

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

diff --git a/ghc/compiler/typecheck/TcRnDriver.lhs b/ghc/compiler/typecheck/TcRnDriver.lhs
index 04b0ca3..1210d3c 100644 (file)
--- a/ghc/compiler/typecheck/TcRnDriver.lhs
+++ b/ghc/compiler/typecheck/TcRnDriver.lhs
@@ -20,9 +20,9 @@ import {-# SOURCE #-} TcSplice( tcSpliceDecls )
 #endif
 
 import CmdLineOpts     ( DynFlag(..), opt_PprStyle_Debug, dopt )
-import HsSyn           ( HsModule(..), HsBinds(..), MonoBinds(..), HsDecl(..), HsExpr(..),
+import HsSyn           ( HsModule(..), HsBinds(..), MonoBinds(..), HsExpr(..),
                          Stmt(..), Pat(VarPat), HsStmtContext(..), RuleDecl(..),
-                         HsGroup(..),
+                         HsGroup(..), SpliceDecl(..),
                          mkSimpleMatch, placeHolderType, toHsType, andMonoBinds,
                          isSrcRule, collectStmtsBinders
                        )
@@ -37,7 +37,7 @@ import MkId           ( unsafeCoerceId )
 import RdrName         ( RdrName, getRdrName, mkUnqual, mkRdrUnqual, 
                          lookupRdrEnv, elemRdrEnv )
 
-import RnHsSyn         ( RenamedHsDecl, RenamedStmt, RenamedTyClDecl, 
+import RnHsSyn         ( RenamedStmt, RenamedTyClDecl, 
                          ruleDeclFVs, instDeclFVs, tyClDeclFVs )
 import TcHsSyn         ( TypecheckedHsExpr, TypecheckedRuleDecl,
                          zonkTopBinds, zonkTopDecls, mkHsLet,
@@ -73,7 +73,7 @@ import TcTyClsDecls   ( tcTyAndClassDecls )
 import RnNames         ( rnImports, exportsFromAvail, reportUnusedNames )
 import RnIfaces                ( slurpImpDecls, checkVersions, RecompileRequired, outOfDate )
 import RnHiFiles       ( readIface, loadOldIface )
-import RnEnv           ( lookupSrcName, lookupOccRn,
+import RnEnv           ( lookupSrcName, lookupOccRn, plusGlobalRdrEnv,
                          ubiquitousNames, implicitModuleFVs, implicitStmtFVs, dataTcOccs )
 import RnExpr          ( rnStmts, rnExpr )
 import RnNames         ( importsFromLocalDecls )
@@ -88,7 +88,7 @@ import ErrUtils               ( mkDumpDoc, showPass )
 import Id              ( Id, mkLocalId, isLocalId, idName, idType, idUnfolding, setIdLocalExported )
 import IdInfo          ( GlobalIdDetails(..) )
 import Var             ( Var, setGlobalIdDetails )
-import Module           ( Module, moduleName, moduleUserString )
+import Module           ( Module, moduleName, moduleUserString, moduleEnvElts )
 import Name            ( Name, isExternalName, getSrcLoc, nameOccName )
 import NameEnv         ( delListFromNameEnv )
 import NameSet
@@ -112,7 +112,7 @@ import HscTypes             ( PersistentCompilerState(..), InteractiveContext(..),
 #ifdef GHCI
 import RdrName         ( rdrEnvElts )
 import RnHiFiles       ( loadInterface )
-import RnEnv           ( mkGlobalRdrEnv, plusGlobalRdrEnv )
+import RnEnv           ( mkGlobalRdrEnv )
 import HscTypes                ( GlobalRdrElt(..), GlobalRdrEnv, ImportReason(..), Provenance(..), 
                          isLocalGRE )
 #endif
@@ -145,9 +145,9 @@ tcRnModule hsc_env pcs
    do {        -- Deal with imports; sets tcg_rdr_env, tcg_imports
        (rdr_env, imports) <- rnImports import_decls ;
        updGblEnv ( \ gbl -> gbl { tcg_rdr_env = rdr_env,
-                                  tcg_imports = imports }) 
+                                  tcg_imports = tcg_imports gbl `plusImportAvails` imports }) 
                     $ do {
-       traceRn (text "rn1") ;
+       traceRn (text "rn1" <+> ppr (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
@@ -172,7 +172,6 @@ tcRnModule hsc_env pcs
        updGblEnv (\gbl -> gbl { tcg_deprecs = tcg_deprecs gbl `plusDeprecs` mod_deprecs })
                  $ do {
 
-       traceRn (text "rn4") ;
                -- Process the export list
        export_avails <- exportsFromAvail exports ;
        updGblEnv (\gbl -> gbl { tcg_exports = export_avails })
@@ -557,6 +556,7 @@ tcRnExtCore hsc_env pcs
        mod_guts = ModGuts {    mg_module   = this_mod,
                                mg_usages   = [],       -- ToDo: compute usage
                                mg_dir_imps = [],       -- ??
+                               mg_deps     = ([],[]),  -- ??
                                mg_exports  = my_exports,
                                mg_types    = final_type_env,
                                mg_insts    = tcg_insts tcg_env,
@@ -597,12 +597,17 @@ tcRnSrcDecls ds
        -- If there is no splice, we're done
        case group_tail of
           Nothing -> return (tcg_env, src_fvs1)
-          Just (splice_expr, rest_ds) -> do {
+          Just (SpliceDecl splice_expr splice_loc, rest_ds) -> do {
 
        setGblEnv tcg_env $ do {
-               
+
+#ifndef GHCI
+       failWithTc (text "Can't do a top-level splice; need a bootstrapped compiler")
+#else
        -- Rename the splice expression, and get its supporting decls
-       (rn_splice_expr, fvs) <- initRn SourceMode (rnExpr splice_expr) ;
+       (rn_splice_expr, fvs) <- initRn SourceMode $
+                                addSrcLoc splice_loc $
+                                rnExpr splice_expr ;
        tcg_env <- importSupportingDecls fvs ;
        setGblEnv tcg_env $ do {
 
@@ -613,7 +618,9 @@ tcRnSrcDecls ds
        (tcg_env, src_fvs2) <- tcRnSrcDecls (spliced_decls ++ rest_ds) ;
 
        return (tcg_env, src_fvs1 `plusFV` src_fvs2)
-    }}}}
+    }
+#endif /* GHCI */
+    }}}
 \end{code}
 
 
@@ -658,6 +665,8 @@ rnTopSrcDecls group
                                                  tcg_imports gbl }) 
                     $ do {
 
+       failIfErrsM ;   -- No point in continuing if (say) we have duplicate declarations
+
                -- Rename the source decls
        (tcg_env, rn_src_decls, src_fvs) <- initRn SourceMode (rnSrcDecls group) ;
        setGblEnv tcg_env $ do {
@@ -1157,11 +1166,14 @@ tcCoreDump mod_guts
 pprTcGblEnv :: TcGblEnv -> SDoc
 pprTcGblEnv (TcGblEnv { tcg_type_env = type_env, 
                        tcg_insts    = dfun_ids, 
-                       tcg_rules    = rules })
+                       tcg_rules    = rules,
+                       tcg_imports  = imports })
   = vcat [ ppr_types dfun_ids type_env
         , ppr_insts dfun_ids
         , vcat (map ppr rules)
-        , ppr_gen_tycons (typeEnvTyCons type_env)]
+        , ppr_gen_tycons (typeEnvTyCons type_env)
+        , ppr (moduleEnvElts (dep_mods imports))
+        , ppr (dep_pkgs imports)]
 
 pprModGuts :: ModGuts -> SDoc
 pprModGuts (ModGuts { mg_types = type_env,