import Bag ( isEmptyBag, unionBags, unionManyBags, bagToList, listToBag )
import CmdLineOpts ( opt_HiMap, opt_NoImplicitPrelude )
import ErrUtils ( SYN_IE(Error), SYN_IE(Warning) )
-import FiniteMap ( emptyFM, eltsFM, fmToList, addToFM, lookupFM{-ToDo:rm-}, FiniteMap )
+import FiniteMap ( emptyFM, eltsFM, fmToList, addToFM, FiniteMap )
import Maybes ( catMaybes )
import Name ( isLocallyDefined, mkWiredInName, getLocalName, isLocalName,
origName,
Name, RdrName(..), ExportFlag(..)
)
-import PprStyle -- ToDo:rm
-import PrelInfo ( builtinNameInfo, SYN_IE(BuiltinNames), SYN_IE(BuiltinKeys) )
-import Pretty -- ToDo:rm
+--import PprStyle -- ToDo:rm
+import PrelInfo ( builtinNameMaps, builtinKeysMap, SYN_IE(BuiltinNames), SYN_IE(BuiltinKeys) )
+import Pretty
import Unique ( ixClassKey )
import UniqFM ( emptyUFM, lookupUFM, addListToUFM_C, eltsUFM )
import UniqSupply ( splitUniqSupply )
-import Util ( panic, assertPanic, pprTrace{-ToDo:rm-} )
+import Util ( panic, assertPanic{-, pprTrace ToDo:rm-} )
\end{code}
\begin{code}
RnEnv, -- final env (for renaming derivings)
[Module], -- imported modules; for profiling
- Name -> ExportFlag, -- export info
+ (Name -> ExportFlag, -- export info
+ ([(Name,ExportFlag)],
+ [(Name,ExportFlag)])),
+
(UsagesMap,
VersionsMap, -- version info; for usage
[Module]), -- instance modules; for iface
\begin{code}
renameModule us input@(HsModule modname _ _ imports _ _ _ _ _ _ _ _ _ _)
- = let
- (b_names, b_keys, _) = builtinNameInfo
+ = {-
+ let
pp_pair (n,m) = ppBesides [ppPStr m,ppChar '.',ppPStr n]
in
- {-
- pprTrace "builtins:\n" (case b_names of { (builtin_ids, builtin_tcs) ->
+ pprTrace "builtins:\n" (case builtinNameMaps of { (builtin_ids, builtin_tcs) ->
ppAboves [ ppCat (map pp_pair (keysFM builtin_ids))
, ppCat (map pp_pair (keysFM builtin_tcs))
- , ppCat (map pp_pair (keysFM b_keys))
+ , ppCat (map pp_pair (keysFM builtinKeysMap))
]}) $
-}
+ -- _scc_ "rnGlobalNames"
makeHiMap opt_HiMap >>= \ hi_files ->
-- pprTrace "HiMap:\n" (ppAboves [ ppCat [ppPStr m, ppStr p] | (m,p) <- fmToList hi_files])
initIfaceCache modname hi_files >>= \ iface_cache ->
- fixIO ( \ ~(_, _, _, _, rec_occ_fm, rec_export_fn) ->
+ fixIO ( \ ~(_, _, _, _, rec_occ_fm, ~(rec_export_fn,_)) ->
let
rec_occ_fn :: Name -> [RdrName]
rec_occ_fn n = case lookupUFM rec_occ_fm n of
Nothing -> []
Just (rn,occs) -> occs
- global_name_info = (b_names, b_keys, rec_export_fn, rec_occ_fn)
+ global_name_info = (builtinNameMaps, builtinKeysMap, rec_export_fn, rec_occ_fn)
in
getGlobalNames iface_cache global_name_info us1 input >>=
\ (occ_env, imp_mods, unqual_imps, imp_fixes, top_errs, top_warns) ->
else
-- No top-level name errors so rename source ...
+ -- _scc_ "rnSource"
case initRn True modname occ_env us2
(rnSource imp_mods unqual_imps imp_fixes input) of {
- ((rn_module, export_fn, src_occs), src_errs, src_warns) ->
+ ((rn_module, export_fn, module_dotdots, src_occs), src_errs, src_warns) ->
--pprTrace "renameModule:" (ppCat (map (ppr PprDebug . fst) (bagToList src_occs))) $
-
let
occ_fm :: UniqFM (RnName, [RdrName])
GT__ -> x : insert new xs
occ_warns = map multipleOccWarn (filter multiple_occs (eltsUFM occ_fm))
- multiple_occs (rn, (o1:o2:_)) = True
+
+ multiple_occs (rn, (o1:o2:_)) = getLocalName o1 /= SLIT("negate")
+ -- the user is rarely responsible if
+ -- "negate" is mentioned in multiple ways
multiple_occs _ = False
in
return (rn_module, imp_mods,
top_errs `unionBags` src_errs,
top_warns `unionBags` src_warns `unionBags` listToBag occ_warns,
- occ_fm, export_fn)
+ occ_fm, (export_fn, module_dotdots))
- }) >>= \ (rn_module, imp_mods, errs_so_far, warns_so_far, occ_fm, export_fn) ->
+ }) >>= \ (rn_module, imp_mods, errs_so_far, warns_so_far, occ_fm, export_stuff) ->
if not (isEmptyBag errs_so_far) then
return (rn_panic, rn_panic, rn_panic, rn_panic, rn_panic, errs_so_far, warns_so_far)
else
-- No errors renaming source so rename the interfaces ...
+ -- _scc_ "preRnIfaces"
let
-- split up all names that occurred in the source; between
-- those that are defined therein and those merely mentioned.
else case (origName "pairify_rn" name) of { OrigName m n ->
Qual m n }
, rn)
-
- must_haves
- | opt_NoImplicitPrelude
- = [{-no Prelude.hi, no point looking-}]
- | otherwise
- = [ name_fn (mkWiredInName u orig ExportAll)
- | (orig@(OrigName mod str), (u, name_fn)) <- fmToList b_keys,
- str `notElem` [ SLIT("main"), SLIT("mainPrimIO")] ]
in
-- ASSERT (isEmptyBag orig_occ_dups)
- (if (isEmptyBag orig_occ_dups) then \x->x
- else pprTrace "orig_occ_dups:" (ppAboves [ ppCat [ppr PprDebug m, ppr PprDebug n, ppr PprDebug o] | (m,n,o) <- bagToList orig_occ_dups])) $
+-- (if (isEmptyBag orig_occ_dups) then \x->x
+-- else pprTrace "orig_occ_dups:" (ppAboves [ ppCat [ppr PprDebug m, ppr PprDebug n, ppr PprDebug o] | (m,n,o) <- bagToList orig_occ_dups])) $
ASSERT (isEmptyBag orig_def_dups)
+ -- _scc_ "rnIfaces"
rnIfaces iface_cache imp_mods us3 orig_def_env orig_occ_env
- rn_module (must_haves ++ imports_used) >>=
+ rn_module (initMustHaves ++ imports_used) >>=
\ (rn_module_with_imports, final_env,
(implicit_val_fm, implicit_tc_fm),
usage_stuff,
return (rn_module_with_imports,
final_env,
imp_mods,
- export_fn,
+ export_stuff,
usage_stuff,
errs_so_far `unionBags` iface_errs,
warns_so_far `unionBags` iface_warns)
(us1, us') = splitUniqSupply us
(us2, us3) = splitUniqSupply us'
+
+initMustHaves :: [RnName]
+ -- things we *must* find declarations for, because the
+ -- compiler may eventually make reference to them (e.g.,
+ -- class Eq)
+initMustHaves
+ | opt_NoImplicitPrelude
+ = [{-no Prelude.hi, no point looking-}]
+ | otherwise
+ = [ name_fn (mkWiredInName u orig ExportAll)
+ | (orig@(OrigName mod str), (u, name_fn)) <- fmToList builtinKeysMap ]
\end{code}
\begin{code}
projects / ghc-hetmet.git / blobdiff