[project @ 2000-11-21 13:13:25 by simonpj]

[ghc-hetmet.git] / ghc / compiler / rename / Rename.lhs

diff --git a/ghc/compiler/rename/Rename.lhs b/ghc/compiler/rename/Rename.lhs
index 7677e22..67195e2 100644 (file)
--- a/ghc/compiler/rename/Rename.lhs
+++ b/ghc/compiler/rename/Rename.lhs
@@ -22,13 +22,13 @@ import RnMonad
 import RnExpr          ( rnExpr )
 import RnNames         ( getGlobalNames, exportsFromAvail )
 import RnSource                ( rnSourceDecls, rnTyClDecl, rnIfaceRuleDecl, rnInstDecl )
-import RnIfaces                ( slurpImpDecls, mkImportInfo, 
+import RnIfaces                ( slurpImpDecls, mkImportInfo, recordLocalSlurps,
                          getInterfaceExports, closeDecls,
                          RecompileRequired, outOfDate, recompileRequired
                        )
 import RnHiFiles       ( readIface, removeContext, loadInterface,
                          loadExports, loadFixDecls, loadDeprecs )
-import RnEnv           ( availsToNameSet, availName, 
+import RnEnv           ( availsToNameSet, availName, mkIfaceGlobalRdrEnv,
                          emptyAvailEnv, unitAvailEnv, availEnvElts, plusAvailEnv, groupAvails,
                          warnUnusedImports, warnUnusedLocalBinds, warnUnusedModules,
                          lookupOrigNames, lookupSrcName, newGlobalName, unQualInScope
@@ -87,15 +87,12 @@ renameModule :: DynFlags
             -> HomeIfaceTable -> HomeSymbolTable
             -> PersistentCompilerState 
             -> Module -> RdrNameHsModule 
-            -> IO (PersistentCompilerState, Maybe (PrintUnqualified, IsExported, ModIface, [RenamedHsDecl]))
+            -> IO (PersistentCompilerState, Maybe (PrintUnqualified, (IsExported, ModIface, [RenamedHsDecl])))
        -- Nothing => some error occurred in the renamer
 
 renameModule dflags hit hst pcs this_module rdr_module
-  = renameSource dflags hit hst pcs this_module get_unqual $
+  = renameSource dflags hit hst pcs this_module $
     rename this_module rdr_module
-  where
-    get_unqual (Just (unqual, _, _, _)) = unqual
-    get_unqual Nothing                 = alwaysQualify
 \end{code}
 
 
@@ -104,16 +101,19 @@ renameExpr :: DynFlags
           -> HomeIfaceTable -> HomeSymbolTable
           -> PersistentCompilerState 
           -> Module -> RdrNameHsExpr
-          -> IO (PersistentCompilerState, Maybe RenamedHsExpr)
+          -> IO (PersistentCompilerState, Maybe (PrintUnqualified, (RenamedHsExpr, [RenamedHsDecl])))
 
 renameExpr dflags hit hst pcs this_module expr
   | Just iface <- lookupModuleEnv hit this_module
   = do { let rdr_env      = mi_globals iface
-       ; let get_unqual _ = unQualInScope rdr_env
+       ; let print_unqual = unQualInScope rdr_env
          
-       ; renameSource dflags hit hst pcs this_module get_unqual $
-         initRnMS rdr_env emptyLocalFixityEnv SourceMode $
-         (rnExpr expr `thenRn` \ (e,_) -> returnRn (Just e))
+       ; renameSource dflags hit hst pcs this_module $
+         initRnMS rdr_env emptyLocalFixityEnv SourceMode (rnExpr expr) `thenRn` \ (e,fvs) -> 
+         slurpImpDecls fvs                                             `thenRn` \ decls ->
+         doptRn Opt_D_dump_rn                                          `thenRn` \ dump_rn ->
+         ioToRnM (dumpIfSet dump_rn "Renamer:" (ppr e))                `thenRn_`
+         returnRn (Just (print_unqual, (e, decls)))
        }
 
   | otherwise
@@ -134,19 +134,22 @@ renameSource :: DynFlags
             -> HomeIfaceTable -> HomeSymbolTable
             -> PersistentCompilerState 
             -> Module 
-            -> (Maybe r -> PrintUnqualified)
-            -> RnMG (Maybe r)
-            -> IO (PersistentCompilerState, Maybe r)
+            -> RnMG (Maybe (PrintUnqualified, r))
+            -> IO (PersistentCompilerState, Maybe (PrintUnqualified, r))
        -- Nothing => some error occurred in the renamer
 
-renameSource dflags hit hst old_pcs this_module get_unqual thing_inside
+renameSource dflags hit hst old_pcs this_module thing_inside
   = do { showPass dflags "Renamer"
 
                -- Initialise the renamer monad
        ; (new_pcs, msgs, maybe_rn_stuff) <- initRn dflags hit hst old_pcs this_module thing_inside
 
                -- Print errors from renaming
-       ;  printErrorsAndWarnings (get_unqual maybe_rn_stuff) msgs ;
+       ;  let print_unqual = case maybe_rn_stuff of
+                               Just (unqual, _) -> unqual
+                               Nothing          -> alwaysQualify
+
+       ;  printErrorsAndWarnings print_unqual msgs ;
 
                -- Return results.  No harm in updating the PCS
        ; if errorsFound msgs then
@@ -157,7 +160,7 @@ renameSource dflags hit hst old_pcs this_module get_unqual thing_inside
 \end{code}
 
 \begin{code}
-rename :: Module -> RdrNameHsModule -> RnMG (Maybe (PrintUnqualified, IsExported, ModIface, [RenamedHsDecl]))
+rename :: Module -> RdrNameHsModule -> RnMG (Maybe (PrintUnqualified, (IsExported, ModIface, [RenamedHsDecl])))
 rename this_module contents@(HsModule _ _ exports imports local_decls mod_deprec loc)
   = pushSrcLocRn loc           $
 
@@ -249,7 +252,7 @@ rename this_module contents@(HsModule _ _ exports imports local_decls mod_deprec
                      imports global_avail_env
                      source_fvs export_avails rn_imp_decls     `thenRn_`
 
-    returnRn (Just (print_unqualified, is_exported, mod_iface, final_decls))
+    returnRn (Just (print_unqualified, (is_exported, mod_iface, final_decls)))
   where
     mod_name = moduleName this_module
 \end{code}
@@ -483,7 +486,7 @@ loadOldIface parsed_iface
                               mi_boot = False, mi_orphan = pi_orphan iface, 
                               mi_fixities = fix_env, mi_deprecs = deprec_env,
                               mi_decls   = decls,
-                              mi_globals = panic "No mi_globals in old interface"
+                              mi_globals = mkIfaceGlobalRdrEnv avails
                    }
     in
     returnRn mod_iface
@@ -560,7 +563,10 @@ closeIfaceDecls dflags hit hst pcs
        needed = unionManyNameSets (map ruleDeclFVs rule_decls) `unionNameSets`
                 unionManyNameSets (map instDeclFVs inst_decls) `unionNameSets`
                 unionManyNameSets (map tyClDeclFVs tycl_decls)
+       local_names    = foldl add emptyNameSet tycl_decls
+       add names decl = addListToNameSet names (map fst (tyClDeclSysNames decl ++ tyClDeclNames decl))
     in
+    recordLocalSlurps local_names      `thenRn_`
     closeDecls decls needed
 \end{code}