summaryrefslogtreecommitdiff
path: root/ghc/compiler/rename
diff options
context:
space:
mode:
Diffstat (limited to 'ghc/compiler/rename')
-rw-r--r--ghc/compiler/rename/Rename.lhs121
-rw-r--r--ghc/compiler/rename/RnEnv.lhs13
-rw-r--r--ghc/compiler/rename/RnHiFiles.lhs62
-rw-r--r--ghc/compiler/rename/RnMonad.lhs22
-rw-r--r--ghc/compiler/rename/RnNames.lhs20
-rw-r--r--ghc/compiler/rename/RnSource.lhs9
6 files changed, 125 insertions, 122 deletions
diff --git a/ghc/compiler/rename/Rename.lhs b/ghc/compiler/rename/Rename.lhs
index 3900bb30df..ad60177718 100644
--- a/ghc/compiler/rename/Rename.lhs
+++ b/ghc/compiler/rename/Rename.lhs
@@ -17,7 +17,7 @@ import RnHsSyn ( RenamedHsDecl, RenamedTyClDecl, RenamedRuleDecl, RenamedInstDe
instDeclFVs, tyClDeclFVs, ruleDeclFVs
)
-import CmdLineOpts ( DynFlags, DynFlag(..), dopt )
+import CmdLineOpts ( DynFlags, DynFlag(..) )
import RnMonad
import RnNames ( getGlobalNames )
import RnSource ( rnSourceDecls, rnTyClDecl, rnIfaceRuleDecl, rnInstDecl )
@@ -27,31 +27,31 @@ import RnIfaces ( slurpImpDecls, mkImportInfo,
)
import RnHiFiles ( readIface, removeContext, loadInterface,
loadExports, loadFixDecls, loadDeprecs )
-import RnEnv ( availsToNameSet, availName,
+import RnEnv ( availsToNameSet, availName,
emptyAvailEnv, unitAvailEnv, availEnvElts, plusAvailEnv, groupAvails,
warnUnusedImports, warnUnusedLocalBinds, warnUnusedModules,
- lookupOrigNames, lookupSrcName, newGlobalName
+ lookupOrigNames, lookupSrcName, newGlobalName, unQualInScope
)
import Module ( Module, ModuleName, WhereFrom(..),
moduleNameUserString, moduleName,
- mkModuleInThisPackage, mkModuleName, moduleEnvElts
+ moduleEnvElts
)
import Name ( Name, NamedThing(..), getSrcLoc,
nameIsLocalOrFrom, nameOccName, nameModule,
)
import Name ( mkNameEnv, nameEnvElts, extendNameEnv )
-import RdrName ( rdrEnvToList, elemRdrEnv, foldRdrEnv, isQual )
+import RdrName ( elemRdrEnv, foldRdrEnv, isQual )
import OccName ( occNameFlavour )
import NameSet
import TysWiredIn ( unitTyCon, intTyCon, boolTyCon )
import PrelNames ( mAIN_Name, pREL_MAIN_Name, pRELUDE_Name,
- ioTyCon_RDR, main_RDR,
+ ioTyCon_RDR, main_RDR_Unqual,
unpackCString_RDR, unpackCStringFoldr_RDR, unpackCStringUtf8_RDR,
eqString_RDR
)
import PrelInfo ( derivingOccurrences )
import Type ( funTyCon )
-import ErrUtils ( dumpIfSet )
+import ErrUtils ( dumpIfSet, showPass, printErrorsAndWarnings, errorsFound )
import Bag ( bagToList )
import FiniteMap ( FiniteMap, fmToList, emptyFM, lookupFM,
addToFM_C, elemFM, addToFM
@@ -64,7 +64,8 @@ import HscTypes ( PersistentCompilerState, HomeIfaceTable, HomeSymbolTable,
ModIface(..), WhatsImported(..),
VersionInfo(..), ImportVersion,
IfaceDecls, mkIfaceDecls, dcl_tycl, dcl_rules, dcl_insts,
- GlobalRdrEnv, AvailEnv, GenAvailInfo(..), AvailInfo, Avails,
+ GlobalRdrEnv, pprGlobalRdrEnv,
+ AvailEnv, GenAvailInfo(..), AvailInfo, Avails,
Provenance(..), ImportReason(..), initialVersionInfo,
Deprecations(..), lookupDeprec, lookupIface
)
@@ -84,25 +85,35 @@ renameModule :: DynFlags
-> HomeIfaceTable -> HomeSymbolTable
-> PersistentCompilerState
-> Module -> RdrNameHsModule
- -> IO (PersistentCompilerState, Maybe (ModIface, [RenamedHsDecl]))
+ -> IO (PersistentCompilerState, Maybe (PrintUnqualified, ModIface, [RenamedHsDecl]))
-- Nothing => some error occurred in the renamer
renameModule dflags hit hst old_pcs this_module rdr_module
- = -- Initialise the renamer monad
- do {
- (new_pcs, errors_found, maybe_rn_stuff)
- <- initRn dflags hit hst old_pcs this_module (rename this_module rdr_module) ;
+ = do { showPass dflags "Renamer"
- -- Return results. No harm in updating the PCS
- if errors_found then
+ -- 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
+
+
+ -- Print errors from renaming
+ ; printErrorsAndWarnings print_unqualified msgs ;
+
+ -- Return results. No harm in updating the PCS
+ ; if errorsFound msgs then
return (new_pcs, Nothing)
- else
+ else
return (new_pcs, maybe_rn_stuff)
}
\end{code}
\begin{code}
-rename :: Module -> RdrNameHsModule -> RnMG (Maybe (ModIface, [RenamedHsDecl]))
+rename :: Module -> RdrNameHsModule -> RnMG (Maybe (PrintUnqualified, ModIface, [RenamedHsDecl]))
rename this_module contents@(HsModule _ _ _ imports local_decls mod_deprec loc)
= pushSrcLocRn loc $
@@ -118,6 +129,9 @@ rename this_module contents@(HsModule _ _ _ imports local_decls mod_deprec loc)
returnRn Nothing
else
+ traceRn (text "Local top-level environment" $$
+ nest 4 (pprGlobalRdrEnv local_gbl_env)) `thenRn_`
+
-- DEAL WITH DEPRECATIONS
rnDeprecs local_gbl_env mod_deprec
[d | DeprecD d <- local_decls] `thenRn` \ my_deprecs ->
@@ -126,9 +140,7 @@ rename this_module contents@(HsModule _ _ _ imports local_decls mod_deprec loc)
fixitiesFromLocalDecls local_gbl_env local_decls `thenRn` \ local_fixity_env ->
-- RENAME THE SOURCE
- initRnMS gbl_env local_fixity_env SourceMode (
- rnSourceDecls local_decls
- ) `thenRn` \ (rn_local_decls, source_fvs) ->
+ rnSourceDecls gbl_env local_fixity_env local_decls `thenRn` \ (rn_local_decls, source_fvs) ->
-- CHECK THAT main IS DEFINED, IF REQUIRED
checkMain this_module local_gbl_env `thenRn_`
@@ -180,13 +192,16 @@ rename this_module contents@(HsModule _ _ _ imports local_decls mod_deprec loc)
mi_deprecs = my_deprecs,
mi_decls = panic "mi_decls"
}
+
+ print_unqualified = unQualInScope gbl_env
in
-- REPORT UNUSED NAMES, AND DEBUG DUMP
- reportUnusedNames mod_iface imports global_avail_env
+ reportUnusedNames mod_iface print_unqualified
+ imports global_avail_env
source_fvs export_avails rn_imp_decls `thenRn_`
- returnRn (Just (mod_iface, final_decls))
+ returnRn (Just (print_unqualified, mod_iface, final_decls))
where
mod_name = moduleName this_module
\end{code}
@@ -197,7 +212,7 @@ Checking that main is defined
checkMain :: Module -> GlobalRdrEnv -> RnMG ()
checkMain this_mod local_env
| moduleName this_mod == mAIN_Name
- = checkRn (main_RDR `elemRdrEnv` local_env) noMainErr
+ = checkRn (main_RDR_Unqual `elemRdrEnv` local_env) noMainErr
| otherwise
= returnRn ()
\end{code}
@@ -360,18 +375,20 @@ checkOldIface :: DynFlags
-- True <=> errors happened
checkOldIface dflags hit hst pcs iface_path source_unchanged maybe_iface
- = case maybe_iface of
+ = runRn dflags hit hst pcs (panic "Bogus module") $
+ case maybe_iface of
Just old_iface -> -- Use the one we already have
- startRn (mi_module old_iface) $
- check_versions old_iface
+ setModuleRn (mi_module old_iface) (check_versions old_iface)
+
Nothing -- try and read it from a file
- -> do read_result <- readIface do_traceRn iface_path
- case read_result of
- Left err -> -- Old interface file not found, or garbled; give up
- do { ioTraceRn (text "Bad old interface file" $$ nest 4 err) ;
- return (pcs, False, (outOfDate, Nothing)) }
- Right parsed_iface
- -> startRn (pi_mod parsed_iface) $
+ -> readIface iface_path `thenRn` \ read_result ->
+ case read_result of
+ Left err -> -- Old interface file not found, or garbled; give up
+ traceRn (text "Bad old interface file" $$ nest 4 err) `thenRn_`
+ returnRn (outOfDate, Nothing)
+
+ Right parsed_iface
+ -> setModuleRn (pi_mod parsed_iface) $
loadOldIface parsed_iface `thenRn` \ m_iface ->
check_versions m_iface
where
@@ -381,10 +398,6 @@ checkOldIface dflags hit hst pcs iface_path source_unchanged maybe_iface
recompileRequired iface_path source_unchanged iface
`thenRn` \ recompile ->
returnRn (recompile, Just iface)
-
- do_traceRn = dopt Opt_D_dump_rn_trace dflags
- ioTraceRn sdoc = if do_traceRn then printErrs sdoc else return ()
- startRn mod = initRn dflags hit hst pcs mod
\end{code}
I think the following function should now have a more representative name,
@@ -487,7 +500,7 @@ closeIfaceDecls :: DynFlags
-- True <=> errors happened
closeIfaceDecls dflags hit hst pcs
mod_iface@(ModIface { mi_module = mod, mi_decls = iface_decls })
- = initRn dflags hit hst pcs mod $
+ = runRn dflags hit hst pcs mod $
let
rule_decls = dcl_rules iface_decls
@@ -510,18 +523,19 @@ closeIfaceDecls dflags hit hst pcs
%*********************************************************
\begin{code}
-reportUnusedNames :: ModIface -> [RdrNameImportDecl]
+reportUnusedNames :: ModIface -> PrintUnqualified
+ -> [RdrNameImportDecl]
-> AvailEnv
-> NameSet -- Used in this module
-> Avails -- Exported by this module
-> [RenamedHsDecl]
-> RnMG ()
-reportUnusedNames my_mod_iface imports avail_env
+reportUnusedNames my_mod_iface unqual imports avail_env
source_fvs export_avails imported_decls
= warnUnusedModules unused_imp_mods `thenRn_`
warnUnusedLocalBinds bad_locals `thenRn_`
warnUnusedImports bad_imp_names `thenRn_`
- printMinimalImports this_mod minimal_imports `thenRn_`
+ printMinimalImports this_mod unqual minimal_imports `thenRn_`
warnDeprecations this_mod export_avails my_deprecs
really_used_names
@@ -570,7 +584,7 @@ reportUnusedNames my_mod_iface imports avail_env
bad_locals = [n | (n,LocalDef) <- defined_but_not_used]
bad_imp_names :: [(Name,Provenance)]
- bad_imp_names = [(n,p) | (n,p@(NonLocalDef (UserImport mod _ True) _)) <- defined_but_not_used,
+ bad_imp_names = [(n,p) | (n,p@(NonLocalDef (UserImport mod _ True))) <- defined_but_not_used,
not (module_unused mod)]
-- inst_mods are directly-imported modules that
@@ -603,9 +617,9 @@ reportUnusedNames my_mod_iface imports avail_env
minimal_imports1 = foldr add_name minimal_imports0 defined_and_used
minimal_imports = foldr add_inst_mod minimal_imports1 inst_mods
- add_name (n,NonLocalDef (UserImport m _ _) _) acc = addToFM_C plusAvailEnv acc (moduleName (nameModule n))
- (unitAvailEnv (mk_avail n))
- add_name (n,other_prov) acc = acc
+ add_name (n,NonLocalDef (UserImport m _ _)) acc = addToFM_C plusAvailEnv acc (moduleName (nameModule n))
+ (unitAvailEnv (mk_avail n))
+ add_name (n,other_prov) acc = acc
mk_avail n = case lookupNameEnv avail_env n of
Just (AvailTC m _) | n==m -> AvailTC n [n]
@@ -667,13 +681,13 @@ warnDeprecations this_mod export_avails my_deprecs used_names
Nothing -> pprPanic "warnDeprecations:" (ppr n)
-- ToDo: deal with original imports with 'qualified' and 'as M' clauses
-printMinimalImports this_mod imps
+printMinimalImports this_mod unqual imps
= doptRn Opt_D_dump_minimal_imports `thenRn` \ dump_minimal ->
if not dump_minimal then returnRn () else
mapRn to_ies (fmToList imps) `thenRn` \ mod_ies ->
ioToRnM (do { h <- openFile filename WriteMode ;
- printForUser h (vcat (map ppr_mod_ie mod_ies))
+ printForUser h unqual (vcat (map ppr_mod_ie mod_ies))
}) `thenRn_`
returnRn ()
where
@@ -764,19 +778,6 @@ getRnStats imported_decls ifaces
hsep [ int n_rules_slurped, text "rule decls imported, out of",
int (n_rules_slurped + n_rules_left), text "read"]
]
-
-count_decls decls
- = (class_decls,
- data_decls,
- newtype_decls,
- syn_decls,
- val_decls,
- inst_decls)
- where
- tycl_decls = [d | TyClD d <- decls]
- (class_decls, data_decls, newtype_decls, syn_decls, val_decls) = countTyClDecls tycl_decls
-
- inst_decls = length [() | InstD _ <- decls]
\end{code}
diff --git a/ghc/compiler/rename/RnEnv.lhs b/ghc/compiler/rename/RnEnv.lhs
index 782ae26d96..82d8993d53 100644
--- a/ghc/compiler/rename/RnEnv.lhs
+++ b/ghc/compiler/rename/RnEnv.lhs
@@ -11,7 +11,7 @@ module RnEnv where -- Export everything
import HsSyn
import RdrHsSyn ( RdrNameIE )
import RdrName ( RdrName, rdrNameModule, rdrNameOcc, isQual, isUnqual, isOrig,
- mkRdrUnqual, mkRdrUnqual, qualifyRdrName, lookupRdrEnv
+ mkRdrUnqual, mkRdrUnqual, qualifyRdrName, lookupRdrEnv, foldRdrEnv
)
import HsTypes ( hsTyVarName, replaceTyVarName )
import HscTypes ( Provenance(..), pprNameProvenance, hasBetterProv,
@@ -539,11 +539,12 @@ in error messages.
\begin{code}
unQualInScope :: GlobalRdrEnv -> Name -> Bool
unQualInScope env
- = lookup
+ = (`elemNameSet` unqual_names)
where
- lookup name = case lookupRdrEnv env (mkRdrUnqual (nameOccName name)) of
- Just [(name',_)] -> name == name'
- other -> False
+ unqual_names :: NameSet
+ unqual_names = foldRdrEnv add emptyNameSet env
+ add rdr_name [(name,_)] unquals | isUnqual rdr_name = addOneToNameSet unquals name
+ add _ _ unquals = unquals
\end{code}
@@ -746,7 +747,7 @@ warnUnusedGroup names
= case prov1 of
LocalDef -> (True, getSrcLoc name1, text "Defined but not used")
- NonLocalDef (UserImport mod loc _) _
+ NonLocalDef (UserImport mod loc _)
-> (True, loc, text "Imported from" <+> quotes (ppr mod) <+> text "but not used")
reportable (name,_) = case occNameUserString (nameOccName name) of
diff --git a/ghc/compiler/rename/RnHiFiles.lhs b/ghc/compiler/rename/RnHiFiles.lhs
index bb16c9f19d..dc0e71d53a 100644
--- a/ghc/compiler/rename/RnHiFiles.lhs
+++ b/ghc/compiler/rename/RnHiFiles.lhs
@@ -17,7 +17,7 @@ module RnHiFiles (
#include "HsVersions.h"
-import CmdLineOpts ( DynFlag(..), opt_IgnoreIfacePragmas )
+import CmdLineOpts ( opt_IgnoreIfacePragmas )
import HscTypes ( ModuleLocation(..),
ModIface(..), emptyModIface,
VersionInfo(..),
@@ -56,13 +56,10 @@ import StringBuffer ( hGetStringBuffer )
import FastString ( mkFastString )
import ErrUtils ( Message )
import Finder ( findModule )
-import Util ( unJust )
import Lex
import FiniteMap
import Outputable
import Bag
-
-import Monad ( when )
\end{code}
@@ -478,16 +475,12 @@ findAndReadIface :: SDoc -> ModuleName
findAndReadIface doc_str mod_name hi_boot_file
= traceRn trace_msg `thenRn_`
+
ioToRnM (findModule mod_name) `thenRn` \ maybe_found ->
- doptRn Opt_D_dump_rn_trace `thenRn` \ rn_trace ->
case maybe_found of
+
Right (Just (wanted_mod,locn))
- -> ioToRnM_no_fail (
- readIface rn_trace
- (unJust (ml_hi_file locn) "findAndReadIface"
- ++ if hi_boot_file then "-boot" else "")
- )
- `thenRn` \ read_result ->
+ -> readIface (mkHiPath hi_boot_file (ml_hi_file locn)) `thenRn` \ read_result ->
case read_result of
Left bad -> returnRn (Left bad)
Right iface
@@ -506,35 +499,42 @@ findAndReadIface doc_str mod_name hi_boot_file
ptext SLIT("interface for"),
ppr mod_name <> semi],
nest 4 (ptext SLIT("reason:") <+> doc_str)]
+
+mkHiPath hi_boot_file (Just path)
+ | hi_boot_file = path ++ "-boot"
+ | otherwise = path
\end{code}
@readIface@ tries just the one file.
\begin{code}
-readIface :: Bool -> String -> IO (Either Message ParsedIface)
+readIface :: String -> RnM d (Either Message ParsedIface)
-- Nothing <=> file not found, or unreadable, or illegible
-- Just x <=> successfully found and parsed
-readIface tr file_path
- = when tr (printErrs (ptext SLIT("readIFace") <+> text file_path))
- >>
- ((hGetStringBuffer False file_path >>= \ contents ->
- case parseIface contents
- PState{ bol = 0#, atbol = 1#,
+readIface file_path
+ = traceRn (ptext SLIT("readIFace") <+> text file_path) `thenRn_`
+
+ ioToRnM (hGetStringBuffer False file_path) `thenRn` \ read_result ->
+ case read_result of {
+ Left io_error -> bale_out (text (show io_error)) ;
+ Right contents ->
+
+ case parseIface contents init_parser_state of
+ POk _ (PIface iface) -> returnRn (Right iface)
+ PFailed err -> bale_out err
+ parse_result -> bale_out empty
+ -- This last case can happen if the interface file is (say) empty
+ -- in which case the parser thinks it looks like an IdInfo or
+ -- something like that. Just an artefact of the fact that the
+ -- parser is used for several purposes at once.
+ }
+ where
+ init_parser_state = PState{ bol = 0#, atbol = 1#,
context = [],
glasgow_exts = 1#,
- loc = mkSrcLoc (mkFastString file_path) 1 } of
- POk _ (PIface iface) -> return (Right iface)
- PFailed err -> bale_out err
- parse_result -> bale_out empty
- -- This last case can happen if the interface file is (say) empty
- -- in which case the parser thinks it looks like an IdInfo or
- -- something like that. Just an artefact of the fact that the
- -- parser is used for several purposes at once.
- )
- `catch`
- (\ io_err -> bale_out (text (show io_err))))
- where
- bale_out err = return (Left (badIfaceFile file_path err))
+ loc = mkSrcLoc (mkFastString file_path) 1 }
+
+ bale_out err = returnRn (Left (badIfaceFile file_path err))
\end{code}
diff --git a/ghc/compiler/rename/RnMonad.lhs b/ghc/compiler/rename/RnMonad.lhs
index 0b96e1668a..6b2fa195c0 100644
--- a/ghc/compiler/rename/RnMonad.lhs
+++ b/ghc/compiler/rename/RnMonad.lhs
@@ -46,7 +46,8 @@ import HscTypes ( AvailEnv, lookupType,
RdrAvailInfo )
import BasicTypes ( Version, defaultFixity )
import ErrUtils ( addShortErrLocLine, addShortWarnLocLine,
- pprBagOfErrors, ErrMsg, WarnMsg, Message
+ pprBagOfErrors, Message, Messages, errorsFound,
+ printErrorsAndWarnings
)
import RdrName ( RdrName, dummyRdrVarName, rdrNameModule, rdrNameOcc,
RdrNameEnv, emptyRdrEnv, extendRdrEnv,
@@ -67,7 +68,6 @@ import Bag ( Bag, emptyBag, isEmptyBag, snocBag )
import UniqSupply
import Outputable
import PrelNames ( mkUnboundName )
-import ErrUtils ( printErrorsAndWarnings )
infixr 9 `thenRn`, `thenRn_`
\end{code}
@@ -102,7 +102,7 @@ traceHiDiffsRn msg
if b then putDocRn msg else returnRn ()
putDocRn :: SDoc -> RnM d ()
-putDocRn msg = ioToRnM (printErrs msg) `thenRn_`
+putDocRn msg = ioToRnM (printDump msg) `thenRn_`
returnRn ()
\end{code}
@@ -139,7 +139,7 @@ data RnDown
-- The Name passed to rn_done is guaranteed to be a Global,
-- so it has a Module, so it can be looked up
- rn_errs :: IORef (Bag WarnMsg, Bag ErrMsg),
+ rn_errs :: IORef Messages,
-- The second and third components are a flattened-out OrigNameEnv
rn_ns :: IORef (UniqSupply, OrigNameNameEnv, OrigNameIParamEnv),
@@ -300,13 +300,18 @@ type ImportedModuleInfo = FiniteMap ModuleName (WhetherHasOrphans, IsBootInterfa
%************************************************************************
\begin{code}
+runRn dflags hit hst pcs mod do_rn
+ = do { (pcs, msgs, r) <- initRn dflags hit hst pcs mod do_rn ;
+ printErrorsAndWarnings alwaysQualify msgs ;
+ return (pcs, errorsFound msgs, r)
+ }
+
initRn :: DynFlags
-> HomeIfaceTable -> HomeSymbolTable
-> PersistentCompilerState
-> Module
-> RnMG t
- -> IO (PersistentCompilerState, Bool, t)
- -- True <=> found errors
+ -> IO (PersistentCompilerState, Messages, t)
initRn dflags hit hst pcs mod do_rn
= do
@@ -358,10 +363,7 @@ initRn dflags hit hst pcs mod do_rn
let new_pcs = pcs { pcs_PIT = iPIT new_ifaces,
pcs_PRS = new_prs }
- -- Check for warnings
- printErrorsAndWarnings (warns, errs) ;
-
- return (new_pcs, not (isEmptyBag errs), res)
+ return (new_pcs, (warns, errs), res)
initRnMS rn_env fixity_env mode thing_inside rn_down g_down
-- The fixity_env appears in both the rn_fixenv field
diff --git a/ghc/compiler/rename/RnNames.lhs b/ghc/compiler/rename/RnNames.lhs
index 0e4d05111d..cccffc3ef1 100644
--- a/ghc/compiler/rename/RnNames.lhs
+++ b/ghc/compiler/rename/RnNames.lhs
@@ -25,7 +25,7 @@ import RnEnv
import RnMonad
import FiniteMap
-import PrelNames ( pRELUDE_Name, mAIN_Name, main_RDR )
+import PrelNames ( pRELUDE_Name, mAIN_Name, main_RDR_Unqual, isUnboundName )
import UniqFM ( lookupUFM )
import Bag ( bagToList )
import Module ( ModuleName, moduleName, WhereFrom(..) )
@@ -67,9 +67,6 @@ getGlobalNames this_mod (HsModule _ _ exports imports decls _ mod_loc)
fixRn ( \ ~(rec_gbl_env, _, rec_export_avails, _) ->
let
- rec_unqual_fn :: Name -> Bool -- Is this chap in scope unqualified?
- rec_unqual_fn = unQualInScope rec_gbl_env
-
rec_exp_fn :: Name -> Bool
rec_exp_fn = mk_export_fn (availsToNameSet rec_export_avails)
in
@@ -89,7 +86,7 @@ getGlobalNames this_mod (HsModule _ _ exports imports decls _ mod_loc)
is_source_import (ImportDecl _ ImportByUserSource _ _ _ _) = True
is_source_import other = False
- get_imports = importsFromImportDecl this_mod_name rec_unqual_fn
+ get_imports = importsFromImportDecl this_mod_name
in
mapAndUnzipRn get_imports ordinary `thenRn` \ (imp_gbl_envs1, imp_avails_s1) ->
mapAndUnzipRn get_imports source `thenRn` \ (imp_gbl_envs2, imp_avails_s2) ->
@@ -144,12 +141,11 @@ getGlobalNames this_mod (HsModule _ _ exports imports decls _ mod_loc)
\begin{code}
importsFromImportDecl :: ModuleName
- -> (Name -> Bool) -- OK to omit qualifier
-> RdrNameImportDecl
-> RnMG (GlobalRdrEnv,
ExportAvails)
-importsFromImportDecl this_mod_name is_unqual (ImportDecl imp_mod_name from qual_only as_mod import_spec iloc)
+importsFromImportDecl this_mod_name (ImportDecl imp_mod_name from qual_only as_mod import_spec iloc)
= pushSrcLocRn iloc $
getInterfaceExports imp_mod_name from `thenRn` \ (imp_mod, avails_by_module) ->
@@ -186,7 +182,6 @@ importsFromImportDecl this_mod_name is_unqual (ImportDecl imp_mod_name from qual
let
mk_provenance name = NonLocalDef (UserImport imp_mod iloc (name `elemNameSet` explicits))
- (is_unqual name)
in
qualifyImports imp_mod_name
@@ -506,7 +501,7 @@ exportsFromAvail this_mod Nothing export_avails global_name_env
= exportsFromAvail this_mod true_exports export_avails global_name_env
where
true_exports = Just $ if this_mod == mAIN_Name
- then [IEVar main_RDR]
+ then [IEVar main_RDR_Unqual]
-- export Main.main *only* unless otherwise specified,
else [IEModuleContents this_mod]
-- but for all other modules export everything.
@@ -547,9 +542,10 @@ exportsFromAvail this_mod (Just export_items)
-- See what's available in the current environment
case lookupUFM entity_avail_env name of {
- Nothing -> -- I can't see why this should ever happen; if the thing
- -- is in scope at all it ought to have some availability
- pprTrace "exportsFromAvail: curious Nothing:" (ppr name)
+ Nothing -> -- Presumably this happens because lookupSrcName didn't find
+ -- the name and returned an unboundName, which won't be in
+ -- the entity_avail_env, of course
+ WARN( not (isUnboundName name), ppr name )
returnRn acc ;
Just avail ->
diff --git a/ghc/compiler/rename/RnSource.lhs b/ghc/compiler/rename/RnSource.lhs
index 42f8ce7f87..c60d850105 100644
--- a/ghc/compiler/rename/RnSource.lhs
+++ b/ghc/compiler/rename/RnSource.lhs
@@ -12,6 +12,7 @@ module RnSource ( rnDecl, rnTyClDecl, rnIfaceRuleDecl, rnInstDecl, rnSourceDecls
import RnExpr
import HsSyn
+import HscTypes ( GlobalRdrEnv )
import HsTypes ( hsTyVarNames, pprHsContext )
import RdrName ( RdrName, isRdrDataCon, rdrNameOcc, mkRdrNameWkr, elemRdrEnv )
import RdrHsSyn ( RdrNameContext, RdrNameHsType, RdrNameConDecl, RdrNameTyClDecl,
@@ -73,11 +74,13 @@ Checks the @(..)@ etc constraints in the export list.
%*********************************************************
\begin{code}
-rnSourceDecls :: [RdrNameHsDecl] -> RnMS ([RenamedHsDecl], FreeVars)
+rnSourceDecls :: GlobalRdrEnv -> LocalFixityEnv
+ -> [RdrNameHsDecl]
+ -> RnMG ([RenamedHsDecl], FreeVars)
-- The decls get reversed, but that's ok
-rnSourceDecls decls
- = go emptyFVs [] decls
+rnSourceDecls gbl_env local_fixity_env decls
+ = initRnMS gbl_env local_fixity_env SourceMode (go emptyFVs [] decls)
where
-- Fixity and deprecations have been dealt with already; ignore them
go fvs ds' [] = returnRn (ds', fvs)
View Lorry Controller Status