+%*********************************************************
+%* *
+\subsection{The main wrappers}
+%* *
+%*********************************************************
+
+\begin{code}
+renameModule :: DynFlags -> GhciMode
+ -> HomeIfaceTable -> HomeSymbolTable
+ -> PersistentCompilerState
+ -> Module -> RdrNameHsModule
+ -> IO (PersistentCompilerState, PrintUnqualified,
+ Maybe (IsExported, ModIface, RnResult))
+ -- Nothing => some error occurred in the renamer
+
+renameModule dflags ghci_mode hit hst pcs this_module rdr_module
+ = renameSource dflags hit hst pcs this_module $
+ rename ghci_mode this_module rdr_module
+\end{code}
+
+\begin{code}
+renameStmt :: DynFlags
+ -> HomeIfaceTable -> HomeSymbolTable
+ -> PersistentCompilerState
+ -> InteractiveContext
+ -> RdrNameStmt -- parsed stmt
+ -> IO ( PersistentCompilerState,
+ PrintUnqualified,
+ Maybe ([Name], (RenamedStmt, [RenamedHsDecl]))
+ )
+
+renameStmt dflags hit hst pcs ic stmt
+ = renameSource dflags hit hst pcs iNTERACTIVE $
+
+ -- load the context module
+ let InteractiveContext{ ic_rn_gbl_env = rdr_env,
+ ic_print_unqual = print_unqual,
+ ic_rn_local_env = local_rdr_env,
+ ic_type_env = type_env } = ic
+ in
+
+ extendTypeEnvRn type_env $
+
+ -- Rename the stmt
+ initRnMS rdr_env emptyAvailEnv local_rdr_env emptyLocalFixityEnv CmdLineMode (
+ rnStmt stmt $ \ stmt' ->
+ returnRn (([], stmt'), emptyFVs)
+ ) `thenRn` \ ((binders, stmt), fvs) ->
+
+ -- Bale out if we fail
+ checkErrsRn `thenRn` \ no_errs_so_far ->
+ if not no_errs_so_far then
+ doDump dflags [] stmt [] `thenRn_` returnRn (print_unqual, Nothing)
+ else
+
+ -- Add implicit free vars, and close decls
+ getImplicitStmtFVs `thenRn` \ implicit_fvs ->
+ slurpImpDecls (fvs `plusFV` implicit_fvs) `thenRn` \ decls ->
+ -- NB: an earlier version deleted (rdrEnvElts local_env) from
+ -- the fvs. But (a) that isn't necessary, because previously
+ -- bound things in the local_env will be in the TypeEnv, and
+ -- the renamer doesn't re-slurp such things, and
+ -- (b) it's WRONG to delete them. Consider in GHCi:
+ -- Mod> let x = e :: T
+ -- Mod> let y = x + 3
+ -- We need to pass 'x' among the fvs to slurpImpDecls, so that
+ -- the latter can see that T is a gate, and hence import the Num T
+ -- instance decl. (See the InTypEnv case in RnIfaces.slurpSourceRefs.)
+
+ doDump dflags binders stmt decls `thenRn_`
+ returnRn (print_unqual, Just (binders, (stmt, decls)))
+
+ where
+ doDump :: DynFlags -> [Name] -> RenamedStmt -> [RenamedHsDecl]
+ -> RnMG (Either IOError ())
+ doDump dflags bndrs stmt decls
+ = ioToRnM (dumpIfSet_dyn dflags Opt_D_dump_rn "Renamer:"
+ (vcat [text "Binders:" <+> ppr bndrs,
+ ppr stmt, text "",
+ vcat (map ppr decls)]))
+
+
+renameRdrName
+ :: DynFlags
+ -> HomeIfaceTable -> HomeSymbolTable
+ -> PersistentCompilerState
+ -> InteractiveContext
+ -> [RdrName] -- name to rename
+ -> IO ( PersistentCompilerState,
+ PrintUnqualified,
+ Maybe ([Name], [RenamedHsDecl])
+ )
+
+renameRdrName dflags hit hst pcs ic rdr_names =
+ renameSource dflags hit hst pcs iNTERACTIVE $
+
+ -- load the context module
+ let InteractiveContext{ ic_rn_gbl_env = rdr_env,
+ ic_print_unqual = print_unqual,
+ ic_rn_local_env = local_rdr_env,
+ ic_type_env = type_env } = ic
+ in
+
+ extendTypeEnvRn type_env $
+
+ -- rename the rdr_name
+ initRnMS rdr_env emptyAvailEnv local_rdr_env emptyLocalFixityEnv CmdLineMode
+ (mapRn (tryRn.lookupOccRn) rdr_names) `thenRn` \ maybe_names ->
+ let
+ ok_names = [ a | Right a <- maybe_names ]
+ in
+ if null ok_names
+ then let errs = head [ e | Left e <- maybe_names ]
+ in setErrsRn errs `thenRn_`
+ doDump dflags ok_names [] `thenRn_`
+ returnRn (print_unqual, Nothing)
+ else
+
+ slurpImpDecls (mkNameSet ok_names) `thenRn` \ decls ->
+
+ doDump dflags ok_names decls `thenRn_`
+ returnRn (print_unqual, Just (ok_names, decls))
+ where
+ doDump :: DynFlags -> [Name] -> [RenamedHsDecl] -> RnMG (Either IOError ())
+ doDump dflags names decls
+ = ioToRnM (dumpIfSet_dyn dflags Opt_D_dump_rn "Renamer:"
+ (vcat [ppr names, text "",
+ vcat (map ppr decls)]))
+\end{code}
+
+\begin{code}
+renameExtCore :: DynFlags
+ -> HomeIfaceTable -> HomeSymbolTable
+ -> PersistentCompilerState
+ -> Module
+ -> RdrNameHsModule
+ -> IO (PersistentCompilerState, PrintUnqualified,
+ Maybe (IsExported, ModIface, [RenamedHsDecl]))
+
+ -- Nothing => some error occurred in the renamer
+renameExtCore dflags hit hst pcs this_module
+ rdr_module@(HsModule _ _ _ _ local_decls _ loc)
+ -- Rename the (Core) module
+ = renameSource dflags hit hst pcs this_module $
+ pushSrcLocRn loc $
+
+ -- Rename the source
+ initIfaceRnMS this_module (rnExtCoreDecls local_decls) `thenRn` \ (rn_local_decls, binders, fvs) ->
+ recordLocalSlurps binders `thenRn_`
+ closeDecls rn_local_decls fvs `thenRn` \ final_decls ->
+
+ -- Bail out if we fail
+ checkErrsRn `thenRn` \ no_errs_so_far ->
+ if not no_errs_so_far then
+ returnRn (print_unqualified, Nothing)
+ else
+ rnDump final_decls [] `thenRn_`
+ 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",
+ -- ToDo: export the data types also.
+ mi_exports = [(moduleName this_module,
+ map Avail (nameSetToList binders))],
+ mi_globals = Nothing,
+ mi_fixities = mkNameEnv [],
+ mi_deprecs = NoDeprecs,
+ mi_decls = panic "mi_decls"
+ }
+
+ is_exported _ = True
+ in
+ returnRn (print_unqualified, Just (is_exported, mod_iface, final_decls))
+
+ where
+ print_unqualified = const False -- print everything qualified.
+
+
+rnExtCoreDecls :: [RdrNameHsDecl]
+ -> RnMS ([RenamedHsDecl],
+ NameSet, -- Binders
+ FreeVars) -- Free variables
+
+rnExtCoreDecls decls
+ -- Renaming external-core decls is rather like renaming an interface file
+ -- All the decls are TyClDecls, and all the names are original names
+ = go [] emptyNameSet emptyNameSet decls
+ where
+ go rn_decls bndrs fvs [] = returnRn (rn_decls, bndrs, fvs)
+
+ go rn_decls bndrs fvs (TyClD decl : decls)
+ = rnTyClDecl decl `thenRn` \ rn_decl ->
+ go (TyClD rn_decl : rn_decls)
+ (addListToNameSet bndrs (map fst (tyClDeclSysNames rn_decl ++ tyClDeclNames rn_decl)))
+ (fvs `plusFV` tyClDeclFVs rn_decl)
+ decls
+
+ go rn_decls bndrs fvs (decl : decls)
+ = addErrRn (text "Unexpected decl in ExtCore file" $$ ppr decl) `thenRn_`
+ go rn_decls bndrs fvs decls
+\end{code}
+
+
+%*********************************************************
+%* *
+\subsection{Make up an interactive context}
+%* *
+%*********************************************************
+
+\begin{code}
+mkGlobalContext
+ :: DynFlags -> HomeIfaceTable -> HomeSymbolTable
+ -> PersistentCompilerState
+ -> [Module] -> [Module]
+ -> IO (PersistentCompilerState, PrintUnqualified, Maybe GlobalRdrEnv)
+mkGlobalContext dflags hit hst pcs toplevs exports
+ = renameSource dflags hit hst pcs iNTERACTIVE $
+
+ mapRn getTopLevScope toplevs `thenRn` \ toplev_envs ->
+ mapRn getModuleExports exports `thenRn` \ export_envs ->
+ let full_env = foldr plusGlobalRdrEnv emptyRdrEnv
+ (toplev_envs ++ export_envs)
+ print_unqual = unQualInScope full_env
+ in
+ checkErrsRn `thenRn` \ no_errs_so_far ->
+ if not no_errs_so_far then
+ returnRn (print_unqual, Nothing)
+ else
+ returnRn (print_unqual, Just full_env)
+
+contextDoc = text "context for compiling statements"
+
+getTopLevScope :: Module -> RnM d GlobalRdrEnv
+getTopLevScope mod =
+ loadInterface contextDoc (moduleName mod) ImportByUser `thenRn` \ iface ->
+ case mi_globals iface of
+ Nothing -> panic "getTopLevScope"
+ Just env -> returnRn env
+
+getModuleExports :: Module -> RnM d GlobalRdrEnv
+getModuleExports mod =
+ loadInterface contextDoc (moduleName mod) ImportByUser `thenRn` \ iface ->
+ returnRn (foldl add emptyRdrEnv (mi_exports iface))
+ where
+ prov_fn n = NonLocalDef ImplicitImport
+ add env (mod,avails) =
+ plusGlobalRdrEnv env (mkGlobalRdrEnv mod True prov_fn avails NoDeprecs)
+\end{code}
+
+%*********************************************************
+%* *
+\subsection{Slurp in a whole module eagerly}
+%* *
+%*********************************************************
+
+\begin{code}
+slurpIface
+ :: DynFlags -> HomeIfaceTable -> HomeSymbolTable
+ -> PersistentCompilerState -> Module
+ -> IO (PersistentCompilerState, PrintUnqualified,
+ Maybe ([Name], [RenamedHsDecl]))
+slurpIface dflags hit hst pcs mod =
+ renameSource dflags hit hst pcs iNTERACTIVE $
+
+ let mod_name = moduleName mod
+ in
+ loadInterface contextDoc mod_name ImportByUser `thenRn` \ iface ->
+ let fvs = availsToNameSet [ avail | (mn,avails) <- mi_exports iface,
+ avail <- avails ]
+ in
+ slurpImpDecls fvs `thenRn` \ rn_imp_decls ->
+ returnRn (alwaysQualify, Just (nameSetToList fvs, rn_imp_decls))
+\end{code}