-renameExpr dflags hit hst pcs this_module expr
- = do { renameSource dflags hit hst pcs this_module $
- tryLoadInterface doc (moduleName this_module) ImportByUser
- `thenRn` \ (iface, maybe_err) ->
- case maybe_err of {
- Just msg -> ioToRnM (printErrs alwaysQualify
- (ptext SLIT("failed to load interface for")
- <+> quotes (ppr this_module)
- <> char ':' <+> msg)) `thenRn_`
- returnRn Nothing;
- Nothing ->
-
- let rdr_env = mi_globals iface
- print_unqual = unQualInScope rdr_env
- in
-
- initRnMS rdr_env emptyLocalFixityEnv SourceMode (rnExpr expr)
- `thenRn` \ (e,fvs) ->
-
- checkErrsRn `thenRn` \ no_errs_so_far ->
- if not no_errs_so_far then
- -- Found errors already, so exit now
- doDump e [] `thenRn_`
- returnRn Nothing
- else
-
- lookupOrigNames implicit_occs `thenRn` \ implicit_names ->
- slurpImpDecls (fvs `plusFV` implicit_names) `thenRn` \ decls ->
-
- doDump e decls `thenRn_`
- returnRn (Just (print_unqual, (e, decls)))
- }}
+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