[project @ 2002-04-05 15:18:25 by sof]

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

diff --git a/ghc/compiler/rename/Rename.lhs b/ghc/compiler/rename/Rename.lhs
index d9a4dcb..0122c0e 100644 (file)
--- a/ghc/compiler/rename/Rename.lhs
+++ b/ghc/compiler/rename/Rename.lhs
@@ -4,10 +4,17 @@
 \section[Rename]{Renaming and dependency analysis passes}
 
 \begin{code}
-module Rename ( 
-       renameModule, RnResult(..), renameStmt, renameRdrName, mkGlobalContext,
-       closeIfaceDecls, checkOldIface, slurpIface
-  ) where
+module Rename 
+        ( renameModule
+       , RnResult(..)
+       , renameStmt
+       , renameRdrName
+       , renameExtCore
+       , mkGlobalContext
+       , closeIfaceDecls
+       , checkOldIface
+       , slurpIface
+        ) where
 
 #include "HsVersions.h"
 
@@ -49,7 +56,7 @@ import Module           ( Module, ModuleName, WhereFrom(..),
 import Name            ( Name, nameModule, isExternalName )
 import NameEnv
 import NameSet
-import RdrName         ( foldRdrEnv, isQual )
+import RdrName         ( foldRdrEnv, isQual, emptyRdrEnv )
 import PrelNames       ( iNTERACTIVE, pRELUDE_Name )
 import ErrUtils                ( dumpIfSet, dumpIfSet_dyn, showPass, 
                          printErrorsAndWarnings, errorsFound )
@@ -195,6 +202,58 @@ renameRdrName dflags hit hst pcs ic rdr_names =
                               vcat (map ppr decls)]))
 \end{code}
 
+\begin{code}
+renameExtCore :: DynFlags
+             -> HomeIfaceTable -> HomeSymbolTable
+             -> PersistentCompilerState 
+             -> Module
+             -> RdrNameHsModule 
+             -> IO (PersistentCompilerState, PrintUnqualified,
+                    Maybe (IsExported, ModIface, RnResult))
+
+       -- Nothing => some error occurred in the renamer
+renameExtCore dflags hit hst pcs this_module 
+              rdr_module@(HsModule _ _ exports imports local_decls mod_deprec loc)
+       -- Rename the (Core) module
+  = renameSource dflags hit hst pcs this_module $
+    pushSrcLocRn loc $  
+       -- RENAME THE SOURCE
+    rnSourceDecls emptyRdrEnv emptyAvailEnv
+                 emptyLocalFixityEnv 
+                 InterfaceMode local_decls `thenRn` \ (rn_local_decls, source_fvs) ->
+    closeDecls rn_local_decls source_fvs    `thenRn` \ final_decls ->            
+       -- print everything qualified.
+    let        print_unqualified = const False in
+       -- Bail out if we fail
+    checkErrsRn                                `thenRn` \ no_errs_so_far ->
+    if not no_errs_so_far then
+        returnRn (print_unqualified, Nothing)
+    else
+     let
+       mod_iface = ModIface {  mi_module   = this_module,
+                               mi_package  = opt_InPackage,
+                               mi_version  = initialVersionInfo,
+                               mi_usages   = [],
+                               mi_boot     = False,
+                               mi_orphan   = panic "is_orphan",
+                               mi_exports  = [],
+                               mi_globals  = Nothing,
+                               mi_fixities = mkNameEnv [],
+                               mi_deprecs  = NoDeprecs,
+                               mi_decls    = panic "mi_decls"
+                   }
+
+       rn_result = RnResult { rr_mod      = this_module,
+                              rr_fixities = mkNameEnv [],
+                              rr_decls    = final_decls,
+                              rr_main     = Nothing }
+
+        is_exported _ = True
+     in
+     returnRn (print_unqualified, Just (is_exported, mod_iface, rn_result))
+\end{code}
+
+
 %*********************************************************
 %*                                                      *
 \subsection{Make up an interactive context}
@@ -363,7 +422,7 @@ rename ghci_mode this_module
 
        -- RENAME THE SOURCE
     rnSourceDecls gbl_env global_avail_env 
-                 local_fixity_env local_decls          `thenRn` \ (rn_local_decls, source_fvs) ->
+                 local_fixity_env SourceMode local_decls `thenRn` \ (rn_local_decls, source_fvs) ->
 
        -- GET ANY IMPLICIT FREE VARIALBES
     getImplicitModuleFVs rn_local_decls          `thenRn` \ implicit_fvs ->