\section[Rename]{Renaming and dependency analysis passes}
\begin{code}
-module Rename ( renameModule, closeIfaceDecls, checkOldIface ) where
+module Rename ( renameModule, renameExpr, closeIfaceDecls, checkOldIface ) where
#include "HsVersions.h"
import HsSyn
-import RdrHsSyn ( RdrNameHsModule, RdrNameHsDecl, RdrNameDeprecation,
+import RdrHsSyn ( RdrNameHsModule, RdrNameHsDecl, RdrNameDeprecation, RdrNameHsExpr,
RdrNameTyClDecl, RdrNameRuleDecl, RdrNameInstDecl, RdrNameImportDecl
)
import RnHsSyn ( RenamedHsDecl, RenamedTyClDecl, RenamedRuleDecl, RenamedInstDecl,
- extractHsTyNames,
+ extractHsTyNames, RenamedHsExpr,
instDeclFVs, tyClDeclFVs, ruleDeclFVs
)
import CmdLineOpts ( DynFlags, DynFlag(..) )
import RnMonad
-import RnNames ( getGlobalNames )
+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 Module ( Module, ModuleName, WhereFrom(..),
moduleNameUserString, moduleName,
- moduleEnvElts
+ moduleEnvElts, lookupModuleEnv
)
import Name ( Name, NamedThing(..), getSrcLoc,
nameIsLocalOrFrom, nameOccName, nameModule,
import IO ( openFile, IOMode(..) )
import HscTypes ( PersistentCompilerState, HomeIfaceTable, HomeSymbolTable,
ModIface(..), WhatsImported(..),
- VersionInfo(..), ImportVersion,
+ VersionInfo(..), ImportVersion, IsExported,
IfaceDecls, mkIfaceDecls, dcl_tycl, dcl_rules, dcl_insts,
GlobalRdrEnv, pprGlobalRdrEnv,
AvailEnv, GenAvailInfo(..), AvailInfo, Avails,
+
%*********************************************************
%* *
-\subsection{The main function: rename}
+\subsection{The two main wrappers}
%* *
%*********************************************************
-> HomeIfaceTable -> HomeSymbolTable
-> PersistentCompilerState
-> Module -> RdrNameHsModule
- -> IO (PersistentCompilerState, Maybe (PrintUnqualified, ModIface, [RenamedHsDecl]))
+ -> IO (PersistentCompilerState, Maybe (PrintUnqualified, (IsExported, ModIface, [RenamedHsDecl])))
-- Nothing => some error occurred in the renamer
-renameModule dflags hit hst old_pcs this_module rdr_module
- = do { showPass dflags "Renamer"
+renameModule dflags hit hst pcs this_module rdr_module
+ = renameSource dflags hit hst pcs this_module $
+ rename this_module rdr_module
+\end{code}
- -- Initialise the renamer monad
- ; (new_pcs, msgs, maybe_rn_stuff) <- initRn dflags hit hst old_pcs this_module
- (rename this_module rdr_module)
- ; let print_unqualified :: Name -> Bool -- Is this chap in scope unqualified?
- print_unqualified = case maybe_rn_stuff of
- Just (unqual, _, _) -> unqual
- Nothing -> alwaysQualify
+\begin{code}
+renameExpr :: DynFlags
+ -> HomeIfaceTable -> HomeSymbolTable
+ -> PersistentCompilerState
+ -> Module -> RdrNameHsExpr
+ -> 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 print_unqual = unQualInScope rdr_env
+
+ ; renameSource dflags hit hst pcs this_module $
+ initRnMS rdr_env emptyLocalFixityEnv SourceMode (rnExpr expr) `thenRn` \ (e,fvs) ->
+ closeDecls [] 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
+ = do { printErrs alwaysQualify (ptext SLIT("renameExpr: Bad module context") <+> ppr this_module)
+ ; return (pcs, Nothing)
+ }
+\end{code}
+%*********************************************************
+%* *
+\subsection{The main function: rename}
+%* *
+%*********************************************************
+
+\begin{code}
+renameSource :: DynFlags
+ -> HomeIfaceTable -> HomeSymbolTable
+ -> PersistentCompilerState
+ -> Module
+ -> RnMG (Maybe (PrintUnqualified, r))
+ -> IO (PersistentCompilerState, Maybe (PrintUnqualified, r))
+ -- Nothing => some error occurred in the renamer
+
+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 print_unqualified 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
\end{code}
\begin{code}
-rename :: Module -> RdrNameHsModule -> RnMG (Maybe (PrintUnqualified, IsExported, ModIface, [RenamedHsDecl]))
-rename this_module contents@(HsModule _ _ _ imports local_decls mod_deprec loc)
+rename :: Module -> RdrNameHsModule -> RnMG (Maybe (PrintUnqualified, (IsExported, ModIface, [RenamedHsDecl])))
+rename this_module contents@(HsModule _ _ exports imports local_decls mod_deprec loc)
= pushSrcLocRn loc $
-- FIND THE GLOBAL NAME ENVIRONMENT
returnRn Nothing
else
- -- PROCESS EXPORT LIST (but not if we've had errors already)
+ -- PROCESS EXPORT LIST
exportsFromAvail mod_name exports all_avails gbl_env `thenRn` \ export_avails ->
traceRn (text "Local top-level environment" $$
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}
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}
projects / ghc-hetmet.git / blobdiff