Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
d2cca44e
Commit
d2cca44e
authored
Oct 23, 2000
by
simonpj
Browse files
[project @ 2000-10-23 16:39:11 by simonpj]
More renamer stuff
parent
0499865e
Changes
11
Expand all
Hide whitespace changes
Inline
Side-by-side
ghc/compiler/basicTypes/Module.lhs
View file @
d2cca44e
...
...
@@ -56,7 +56,8 @@ module Module
, elemModuleEnv, extendModuleEnv, extendModuleEnvList, plusModuleEnv_C
, delModuleEnvList, delModuleEnv, plusModuleEnv, lookupModuleEnv
, lookupWithDefaultModuleEnv, mapModuleEnv, mkModuleEnv, emptyModuleEnv
, rngModuleEnv, unitModuleEnv, isEmptyModuleEnv, foldModuleEnv, lookupModuleEnvByName
, rngModuleEnv, unitModuleEnv, isEmptyModuleEnv, foldModuleEnv
, lookupModuleEnvByName, extendModuleEnv_C
) where
...
...
@@ -266,6 +267,7 @@ emptyModuleEnv :: ModuleEnv a
mkModuleEnv :: [(Module, a)] -> ModuleEnv a
unitModuleEnv :: Module -> a -> ModuleEnv a
extendModuleEnv :: ModuleEnv a -> Module -> a -> ModuleEnv a
extendModuleEnv_C :: (a->a->a) -> ModuleEnv a -> Module -> a -> ModuleEnv a
plusModuleEnv :: ModuleEnv a -> ModuleEnv a -> ModuleEnv a
extendModuleEnvList :: ModuleEnv a -> [(Module, a)] -> ModuleEnv a
...
...
@@ -284,6 +286,7 @@ foldModuleEnv :: (a -> b -> b) -> b -> ModuleEnv a -> b
elemModuleEnv = elemUFM
extendModuleEnv = addToUFM
extendModuleEnv_C = addToUFM_C
extendModuleEnvList = addListToUFM
plusModuleEnv_C = plusUFM_C
delModuleEnvList = delListFromUFM
...
...
ghc/compiler/basicTypes/VarEnv.lhs
View file @
d2cca44e
...
...
@@ -8,7 +8,7 @@ module VarEnv (
VarEnv, IdEnv, TyVarEnv,
emptyVarEnv, unitVarEnv, mkVarEnv,
elemVarEnv, rngVarEnv,
extendVarEnv, extendVarEnvList,
extendVarEnv,
extendVarEnv_C,
extendVarEnvList,
plusVarEnv, plusVarEnv_C,
delVarEnvList, delVarEnv,
lookupVarEnv, lookupVarEnv_NF, lookupWithDefaultVarEnv,
...
...
@@ -127,6 +127,7 @@ mkVarEnv :: [(Var, a)] -> VarEnv a
zipVarEnv :: [Var] -> [a] -> VarEnv a
unitVarEnv :: Var -> a -> VarEnv a
extendVarEnv :: VarEnv a -> Var -> a -> VarEnv a
extendVarEnv_C :: (a->a->a) -> VarEnv a -> Var -> a -> VarEnv a
plusVarEnv :: VarEnv a -> VarEnv a -> VarEnv a
extendVarEnvList :: VarEnv a -> [(Var, a)] -> VarEnv a
...
...
@@ -148,6 +149,7 @@ foldVarEnv :: (a -> b -> b) -> b -> VarEnv a -> b
\begin{code}
elemVarEnv = elemUFM
extendVarEnv = addToUFM
extendVarEnv_C = addToUFM_C
extendVarEnvList = addListToUFM
plusVarEnv_C = plusUFM_C
delVarEnvList = delListFromUFM
...
...
ghc/compiler/main/HscMain.lhs
View file @
d2cca44e
...
...
@@ -21,6 +21,7 @@ import SrcLoc ( mkSrcLoc )
import Rename ( renameModule )
import PrelInfo ( wiredInThings )
import PrelRules ( builtinRules )
import MkIface ( writeIface )
import TcModule ( TcResults(..), typecheckModule )
import Desugar ( deSugar )
...
...
@@ -254,7 +255,7 @@ initPersistentCompilerState :: PersistentCompilerState
initPersistentCompilerState
= PCS { pcs_PST = initPackageDetails,
pcs_insts = emptyInstEnv,
pcs_rules =
empty
Rule
Env
,
pcs_rules =
init
Rule
s
,
pcs_PRS = initPersistentRenamerState }
initPackageDetails :: PackageSymbolTable
...
...
@@ -273,4 +274,11 @@ initOrigNames = grab knownKeyNames `plusFM` grab (map getName wiredInThings)
where
grab names = foldl add emptyFM names
add env name = addToFM env (moduleName (nameModule name), nameOccName name) name
initRules :: RuleEnv
initRules = foldl add emptyVarEnv builtinRules
where
add env (name,rule) = extendNameEnv_C add1 env name [rule]
add1 rules _ = rule : rules
\end{code}
ghc/compiler/main/HscTypes.lhs
View file @
d2cca44e
...
...
@@ -21,7 +21,7 @@ module HscTypes (
WhetherHasOrphans, ImportVersion, WhatsImported(..),
PersistentRenamerState(..), IsBootInterface, Avails, DeclsMap,
IfaceInsts, IfaceRules, Deprecation
Env
, GatedDecl,
IfaceInsts, IfaceRules, Deprecation
s(..)
, GatedDecl,
OrigNameEnv(..), OrigNameNameEnv, OrigNameIParamEnv,
AvailEnv, AvailInfo, GenAvailInfo(..),
PersistentCompilerState(..),
...
...
@@ -113,13 +113,16 @@ data ModIface
mi_module :: Module, -- Complete with package info
mi_version :: VersionInfo, -- Module version number
mi_orphan :: WhetherHasOrphans, -- Whether this module has orphans
mi_usages :: [ImportVersion Name], -- Usages
mi_exports :: Avails, -- What it exports
mi_exports :: Avails, -- What it exports; kept sorted by (mod,occ),
-- to make version comparisons easier
mi_globals :: GlobalRdrEnv, -- Its top level environment
mi_fixities :: NameEnv Fixity, -- Fixities
mi_deprecs ::
NameEnv DeprecTxt,
-- Deprecations
mi_deprecs ::
Deprecations,
-- Deprecations
mi_decls :: [RenamedHsDecl] -- types, classes
-- inst decls, rules, iface sigs
...
...
@@ -149,7 +152,7 @@ emptyModIface mod
= ModIface { mi_module = mod,
mi_exports = [],
mi_globals = emptyRdrEnv,
mi_deprecs =
emptyNameEnv,
mi_deprecs =
NoDeprecs
}
\end{code}
...
...
@@ -258,13 +261,16 @@ data VersionInfo
-- the parent class/tycon changes
}
type DeprecationEnv = NameEnv DeprecTxt -- Give reason for deprecation
data Deprecations = NoDeprecs
| DeprecAll DeprecTxt -- Whole module deprecated
| DeprecSome (NameEnv DeprecTxt) -- Some things deprecated
-- Just "big" names
type InstEnv = UniqFM ClsInstEnv -- Maps Class to instances for that class
type ClsInstEnv = [(TyVarSet, [Type], DFunId)] -- The instances for a particular class
type DFunId = Id
type RuleEnv =
Id
Env [CoreRule]
type RuleEnv =
Name
Env [CoreRule]
emptyRuleEnv = emptyVarEnv
\end{code}
...
...
@@ -468,16 +474,6 @@ instance Ord ImportReason where
= (m1 `compare` m2) `thenCmp` (loc1 `compare` loc2)
{-
Moved here from Name.
pp_prov (LocalDef _ Exported) = char 'x'
pp_prov (LocalDef _ NotExported) = char 'l'
pp_prov (NonLocalDef ImplicitImport _) = char 'j'
pp_prov (NonLocalDef (UserImport _ _ True ) _) = char 'I' -- Imported by name
pp_prov (NonLocalDef (UserImport _ _ False) _) = char 'i' -- Imported by ..
pp_prov SystemProv = char 's'
-}
data ImportReason
= UserImport Module SrcLoc Bool -- Imported from module M on line L
-- Note the M may well not be the defining module
...
...
@@ -510,7 +506,7 @@ hasBetterProv (NonLocalDef (UserImport _ _ _ ) _) (NonLocalDef ImplicitImport
hasBetterProv _ _ = False
pprNameProvenance :: Name -> Provenance -> SDoc
pprNameProvenance name LocalDef
= ptext SLIT("defined at") <+> ppr (nameSrcLoc name)
pprNameProvenance name LocalDef = ptext SLIT("defined at") <+> ppr (nameSrcLoc name)
pprNameProvenance name (NonLocalDef why _) = sep [ppr_reason why,
nest 2 (parens (ppr_defn (nameSrcLoc name)))]
...
...
ghc/compiler/prelude/PrelRules.lhs
View file @
d2cca44e
...
...
@@ -429,7 +429,8 @@ builtinRules
]
-- unpackFoldrCString# "foo" c (unpackFoldrCString# "baz" c n) = unpackFoldrCString# "foobaz" c n
-- The rule is this:
-- unpackFoldrCString# "foo" c (unpackFoldrCString# "baz" c n) = unpackFoldrCString# "foobaz" c n
match_append_lit_str [Type ty1,
Lit (MachStr s1),
...
...
ghc/compiler/rename/ParseIface.y
View file @
d2cca44e
...
...
@@ -225,16 +225,16 @@ iface : '__interface' package mod_name
pi_mod
=
mkModule
$
3
$
2
,
--
Module
itself
pi_vers
=
$
4
,
--
Module
version
pi_orphan
=
$
6
,
pi_exports
=
$
9
,
--
Exports
pi_exports
=
(
fst
$
5
,
$
9
),
--
Exports
pi_usages
=
$
10
,
--
Usages
pi_fixity
=
(
fst
$
5
,
$
11
)
,
--
Fixies
pi_fixity
=
$
11
,
--
Fixies
pi_insts
=
$
12
,
--
Local
instances
pi_decls
=
$
13
,
--
Decls
pi_rules
=
(
snd
$
5
,
fst
$
14
),
--
Rules
pi_deprecs
=
snd
$
14
--
Deprecations
}
}
--
Versions
for
fixitie
s
and
rules
(
optional
)
--
Versions
for
export
s
and
rules
(
optional
)
sub_versions
::
{
(
Version
,
Version
)
}
:
'['
version
version
']'
{
($
2
,$
3
)
}
|
{-
empty
-}
{
(
initialVersion
,
initialVersion
)
}
...
...
ghc/compiler/rename/Rename.lhs
View file @
d2cca44e
This diff is collapsed.
Click to expand it.
ghc/compiler/rename/RnEnv.lhs
View file @
d2cca44e
...
...
@@ -16,7 +16,7 @@ import RdrName ( RdrName, rdrNameModule, rdrNameOcc, isQual, isUnqual,
import HsTypes ( hsTyVarName, replaceTyVarName )
import HscTypes ( Provenance(..), pprNameProvenance, hasBetterProv,
ImportReason(..), GlobalRdrEnv, AvailEnv,
AvailInfo, GenAvailInfo(..), RdrAvailInfo )
AvailInfo,
Avails,
GenAvailInfo(..), RdrAvailInfo )
import RnMonad
import Name ( Name, NamedThing(..),
getSrcLoc,
...
...
@@ -582,16 +582,19 @@ availNames :: GenAvailInfo name -> [name]
availNames (Avail n) = [n]
availNames (AvailTC n ns) = ns
-------------------------------------
addSysAvails :: AvailInfo -> [Name] -> AvailInfo
addSysAvails avail [] = avail
addSysAvails (AvailTC n ns) sys = AvailTC n (sys ++ ns)
-------------------------------------
rdrAvailInfo :: AvailInfo -> RdrAvailInfo
-- Used when building the avails we are going to put in an interface file
-- We sort the components to reduce needless wobbling of interfaces
rdrAvailInfo (Avail n) = Avail (nameOccName n)
rdrAvailInfo (AvailTC n ns) = AvailTC (nameOccName n) (sortLt (<) (map nameOccName ns))
-------------------------------------
filterAvail :: RdrNameIE -- Wanted
-> AvailInfo -- Available
-> Maybe AvailInfo -- Resulting available;
...
...
@@ -627,6 +630,21 @@ filterAvail (IEThingAll _) avail@(AvailTC _ _) = Just avail
filterAvail ie avail = Nothing
-------------------------------------
sortAvails :: Avails -> Avails
sortAvails avails = sortLt lt avails
where
a1 `lt` a2 = mod1 < mod2 ||
(mod1 == mod2 && occ1 < occ2)
where
name1 = availName a1
name2 = availName a2
mod1 = nameModule name1
mod2 = nameModule name2
occ1 = nameOccName name1
occ2 = nameOccName name2
-------------------------------------
pprAvail :: AvailInfo -> SDoc
pprAvail (AvailTC n ns) = ppr n <> case filter (/= n) ns of
[] -> empty
...
...
@@ -678,7 +696,7 @@ mapFvRn f xs = mapRn f xs `thenRn` \ stuff ->
%************************************************************************
\begin{code}
warnUnusedModules :: [Module] -> RnM d ()
warnUnusedModules :: [Module
Name
] -> RnM d ()
warnUnusedModules mods
= doptRn Opt_WarnUnusedImports `thenRn` \ warn ->
if warn then mapRn_ (addWarnRn . unused_mod) mods
...
...
@@ -687,7 +705,7 @@ warnUnusedModules mods
unused_mod m = vcat [ptext SLIT("Module") <+> quotes (ppr m) <+>
text "is imported, but nothing from it is used",
parens (ptext SLIT("except perhaps to re-export instances visible in") <+>
quotes (ppr
(moduleName m)
))]
quotes (ppr
m
))]
warnUnusedImports :: [(Name,Provenance)] -> RnM d ()
warnUnusedImports names
...
...
ghc/compiler/rename/RnIfaces.lhs
View file @
d2cca44e
...
...
@@ -11,8 +11,8 @@ module RnIfaces
getInterfaceExports,
getImportedInstDecls, getImportedRules,
lookupFixityRn, loadHomeInterface,
importDecl, ImportDeclResult(..), recordLocalSlurps,
loadBuiltinRules,
mkImport
Export
Info, getSlurped,
importDecl, ImportDeclResult(..), recordLocalSlurps,
mkImportInfo, getSlurped,
getDeclBinders, getDeclSysBinders,
removeContext -- removeContext probably belongs somewhere else
...
...
@@ -47,8 +47,8 @@ import Name ( Name {-instance NamedThing-}, nameOccName,
import Module ( Module, ModuleEnv,
moduleName, isModuleInThisPackage,
ModuleName, WhereFrom(..),
extendModuleEnv, lookupModuleEnv, lookupModuleEnvByName,
plus
ModuleEnv_C, lookupWithDefaultModuleEnv
emptyModuleEnv,
extendModuleEnv, lookupModuleEnv, lookupModuleEnvByName,
extend
ModuleEnv_C, lookupWithDefaultModuleEnv
)
import RdrName ( RdrName, rdrNameOcc )
import NameSet
...
...
@@ -171,13 +171,13 @@ tryLoadInterface doc_str mod_name from
loadDecls mod (iDecls ifaces) (pi_decls iface) `thenRn` \ (decls_vers, new_decls) ->
loadRules mod (iRules ifaces) (pi_rules iface) `thenRn` \ (rule_vers, new_rules) ->
loadFixDecls mod_name (pi_fixity iface) `thenRn` \
(fix_vers,
fix_env
)
->
foldlRn (
loadDeprec mod
) emptyNameEnv
(pi_deprecs iface) `thenRn` \ deprec_env ->
loadFixDecls mod_name (pi_fixity iface) `thenRn` \ fix_env ->
loadDeprec
s
mod
(pi_deprecs iface) `thenRn` \ deprec_env ->
foldlRn (loadInstDecl mod) (iInsts ifaces) (pi_insts iface) `thenRn` \ new_insts ->
loadExports (pi_exports iface) `thenRn` \ avails ->
loadExports (pi_exports iface) `thenRn` \
(export_vers,
avails
)
->
let
version = VersionInfo { vers_module = pi_vers iface,
fixVers = fix
_vers,
vers_exports = export
_vers,
vers_rules = rule_vers,
vers_decls = decls_vers }
...
...
@@ -225,7 +225,7 @@ addModDeps mod new_deps mod_deps
-- Don't record dependencies when importing a module from another package
-- Except for its descendents which contain orphans,
-- and in that case, forget about the boot indicator
filtered_new_deps :: [(ModuleName, (WhetherHasOrphans, IsBootInterface))]
filtered_new_deps :: [(ModuleName, (WhetherHasOrphans, IsBootInterface
, IsLoaded
))]
filtered_new_deps
| isModuleInThisPackage mod
= [ (imp_mod, (has_orphans, is_boot, False))
...
...
@@ -247,11 +247,11 @@ addModDeps mod new_deps mod_deps
-- Loading the export list
-----------------------------------------------------
loadExports :: [ExportItem] -> RnM d Avails
loadExports items
loadExports ::
(Version,
[ExportItem]
)
-> RnM d
(Version,
Avails
)
loadExports
(vers,
items
)
= getModuleRn `thenRn` \ this_mod ->
mapRn (loadExport this_mod) items `thenRn` \ avails_s ->
returnRn (concat avails_s)
returnRn (
vers,
concat avails_s)
loadExport :: Module -> ExportItem -> RnM d [AvailInfo]
...
...
@@ -361,9 +361,9 @@ loadDecl mod (version_map, decls_map) (version, decl)
-- Loading fixity decls
-----------------------------------------------------
loadFixDecls mod_name
(version,
decls
)
loadFixDecls mod_name decls
= mapRn (loadFixDecl mod_name) decls `thenRn` \ to_add ->
returnRn (
version,
mkNameEnv to_add)
returnRn (mkNameEnv to_add)
loadFixDecl mod_name sig@(FixitySig rdr_name fixity loc)
= newGlobalName mod_name (rdrNameOcc rdr_name) `thenRn` \ name ->
...
...
@@ -431,31 +431,20 @@ loadRule mod decl@(IfaceRule _ _ var _ _ src_loc)
= lookupOrigName var `thenRn` \ var_name ->
returnRn (unitNameSet var_name, (mod, RuleD decl))
loadBuiltinRules :: [(RdrName, CoreRule)] -> RnMG ()
loadBuiltinRules builtin_rules
= getIfacesRn `thenRn` \ ifaces ->
mapRn loadBuiltinRule builtin_rules `thenRn` \ rule_decls ->
setIfacesRn (ifaces { iRules = iRules ifaces `unionBags` listToBag rule_decls })
loadBuiltinRule (var, rule)
= lookupOrigName var `thenRn` \ var_name ->
returnRn (unitNameSet var_name, (nameModule var_name, RuleD (IfaceRuleOut var rule)))
-----------------------------------------------------
-- Loading Deprecations
-----------------------------------------------------
loadDeprec :: Module -> DeprecationEnv -> RdrNameDeprecation -> RnM d DeprecationEnv
loadDeprec mod deprec_env (Deprecation (IEModuleContents _) txt _)
= traceRn (text "module deprecation not yet implemented:" <+> ppr mod <> colon <+> ppr txt) `thenRn_`
-- SUP: TEMPORARY HACK, ignoring module deprecations for now
returnRn deprec_env
loadDeprec mod deprec_env (Deprecation ie txt _)
= setModuleRn mod $
mapRn lookupOrigName (ieNames ie) `thenRn` \ names ->
traceRn (text "loaded deprecation(s) for" <+> hcat (punctuate comma (map ppr names)) <> colon <+> ppr txt) `thenRn_`
loadDeprecs :: Module -> [RdrNameDeprecation] -> RnM d Deprecations
loadDeprecs m [] = returnRn NoDeprecs
loadDeprecs m [Deprecation (IEModuleContents _) txt _] = returnRn (DeprecAll txt)
loadDeprecs m deprecs = setModuleRn m $
foldlRn loadDeprec emptyNameEnv deprecs `thenRn` \ env ->
returnRn (DeprecSome env)
loadDeprec deprec_env (Deprecation ie txt _)
= mapRn lookupOrigName (ieNames ie) `thenRn` \ names ->
traceRn (text "Loaded deprecation(s) for" <+> hcat (punctuate comma (map ppr names)) <> colon <+> ppr txt) `thenRn_`
returnRn (extendNameEnvList deprec_env (zip names (repeat txt)))
\end{code}
...
...
@@ -782,33 +771,32 @@ imports A. This line says that A imports B, but uses nothing in it.
So we'll get an early bale-out when compiling A if B's version changes.
\begin{code}
mkImportExportInfo :: ModuleName -- Name of this module
-> Avails -- Info about exports
-> [ImportDecl n] -- The import decls
-> RnMG ([ExportItem], -- Export info for iface file; sorted
[ImportVersion Name]) -- Import info for iface file; sorted
-- Both results are sorted into canonical order to
-- reduce needless wobbling of interface files
mkImportExportInfo this_mod export_avails exports
mkImportInfo :: ModuleName -- Name of this module
-> [ImportDecl n] -- The import decls
-> RnMG [ImportVersion Name]
mkImportInfo this_mod imports
= getIfacesRn `thenRn` \ ifaces ->
getHomeIfaceTableRn `thenRn` \ hit ->
let
import_all_mods :: [ModuleName]
-- Modules where we imported all the names
-- (apart from hiding some, perhaps)
import_all_mods = nub [ m | ImportDecl m _ _ _ imp_list _ <- imports ]
import_all_mods = nub [ m | ImportDecl m _ _ _ imp_list _ <- imports,
import_all imp_list ]
import_all (Just (False, _)) = False -- Imports are specified explicitly
import_all other = True -- Everything is imported
mod_map = iImpModInfo ifaces
imp_names = iVSlurp ifaces
pit = iPIT ifaces
-- mv_map groups together all the things imported from a particular module.
mv_map :: ModuleEnv [Name]
mv_map = foldr add_mv empty
F
M imp_names
mv_map = foldr add_mv emptyM
oduleEnv
imp_names
add_mv
(
name
, version)
mv_map = addItem mv_map (nameModule name) name
add_mv name mv_map = addItem mv_map (nameModule name) name
-- Build the result list by adding info for each module.
-- For (a) a library module, we don't record it at all unless it contains orphans
...
...
@@ -847,10 +835,10 @@ mkImportExportInfo this_mod export_avails exports
= so_far
| is_lib_module -- Record the module version only
= go_for_it (Everything
vers_
module)
= go_for_it (Everything module
_vers
)
| otherwise
= go_for_it
(mk_
whats_imported
mod vers_module)
= go_for_it whats_imported
where
go_for_it exports = (mod_name, has_orphans, is_boot, exports) : so_far
...
...
@@ -859,12 +847,14 @@ mkImportExportInfo this_mod export_avails exports
is_lib_module = not (isModuleInThisPackage mod)
version_info = mi_version mod_iface
version_env = vers_decls version_info
module_vers = vers_module version_info
whats_imported = Specifically mod_vers export_vers import_items
whats_imported = Specifically module_vers
export_vers import_items
(vers_rules version_info)
import_items = [(n,v) | n <- lookupWithDefaultModuleEnv mv_map [] mod,
let v = lookupNameEnv version_env `orElse`
let v = lookupNameEnv version_env
n
`orElse`
pprPanic "mk_whats_imported" (ppr n)
]
export_vers | moduleName mod `elem` import_all_mods
...
...
@@ -873,22 +863,13 @@ mkImportExportInfo this_mod export_avails exports
= Nothing
import_info = foldFM mk_imp_info [] mod_map
-- Sort exports into groups by module
export_fm :: FiniteMap Module [RdrAvailInfo]
export_fm = foldr insert emptyFM export_avails
insert avail efm = addItem efm (nameModule (availName avail))
avail
export_info = fmToList export_fm
in
traceRn (text "Modules in Ifaces: " <+> fsep (map ppr (keysFM mod_map))) `thenRn_`
returnRn
(export_info,
import_info
)
returnRn import_info
addItem :: ModuleEnv [a] -> Module -> a -> ModuleEnv [a]
addItem fm mod x =
plus
ModuleEnv_C add_item fm mod [x]
addItem fm mod x =
extend
ModuleEnv_C add_item fm mod [x]
where
add_item xs _ = x:xs
\end{code}
...
...
@@ -1044,7 +1025,7 @@ findAndReadIface doc_str mod_name hi_boot_file
ioToRnM (finder mod_name) `thenRn` \ maybe_found ->
case maybe_found of
Just (mod,locn)
Right (
Just (mod,locn)
)
| hi_boot_file -> readIface mod (hi_file locn ++ "-hi-boot")
| otherwise -> readIface mod (hi_file locn)
...
...
@@ -1129,7 +1110,7 @@ warnRedundantSourceImport mod_name
= ptext SLIT("Unnecessary {- SOURCE -} in the import of module")
<+> quotes (ppr mod_name)
hiModuleNameMismatchWarn :: Module -> Module
Name
-> Message
hiModuleNameMismatchWarn :: Module -> Module -> Message
hiModuleNameMismatchWarn requested_mod read_mod =
hsep [ ptext SLIT("Something is amiss; requested module name")
, ppr (moduleName requested_mod)
...
...
ghc/compiler/rename/RnMonad.lhs
View file @
d2cca44e
...
...
@@ -201,11 +201,10 @@ data ParsedIface
pi_vers :: Version, -- Module version number
pi_orphan :: WhetherHasOrphans, -- Whether this module has orphans
pi_usages :: [ImportVersion OccName], -- Usages
pi_exports :: [ExportItem],
-- Exports
pi_exports ::
(Version,
[ExportItem]
)
, -- Exports
pi_insts :: [RdrNameInstDecl], -- Local instance declarations
pi_decls :: [(Version, RdrNameHsDecl)], -- Local definitions
pi_fixity :: (Version, [RdrNameFixitySig]), -- Local fixity declarations,
-- with their version
pi_fixity :: [RdrNameFixitySig], -- Local fixity declarations,
pi_rules :: (Version, [RdrNameRuleDecl]), -- Rules, with their version
pi_deprecs :: [RdrNameDeprecation] -- Deprecations
}
...
...
@@ -290,7 +289,7 @@ initRn :: DynFlags
-> Module
-> SrcLoc
-> RnMG t
-> IO (t,
PersistentCompilerState,
(Bag WarnMsg, Bag ErrMsg))
-> IO (t, (Bag WarnMsg, Bag ErrMsg)
, PersistentCompilerState
)
initRn dflags finder hit hst pcs mod loc do_rn
= do
...
...
@@ -330,7 +329,7 @@ initRn dflags finder hit hst pcs mod loc do_rn
let new_pcs = pcs { pcs_PIT = iPIT new_ifaces,
pcs_PRS = new_prs }
return (res,
new_pcs,
(warns, errs))
return (res, (warns, errs)
, new_pcs
)
is_done :: HomeSymbolTable -> PackageSymbolTable -> Name -> Bool
-- Returns True iff the name is in either symbol table
...
...
@@ -402,8 +401,8 @@ renameSourceCode dflags mod prs m
rn_loc = generatedSrcLoc, rn_ns = names_var,
rn_errs = errs_var,
rn_mod = mod,
rn_
ifaces = panic "rnameSourceCode: rn_ifaces", -- Not required
rn_
finder = panic "rnameSourceCode: rn_finder" -- Not required
rn_
done = bogus "rn_done", rn_hit = bogus "rn_hit",
rn_
ifaces = bogus "rn_ifaces", rn_finder = bogus "rn_finder"
}
s_down = SDown { rn_mode = InterfaceMode,
-- So that we can refer to PrelBase.True etc
...
...
@@ -428,6 +427,8 @@ renameSourceCode dflags mod prs m
where
display errs = pprBagOfErrors errs
bogus s = panic ("rnameSourceCode: " ++ s) -- Used for unused record fields
{-# INLINE thenRn #-}
{-# INLINE thenRn_ #-}
{-# INLINE returnRn #-}
...
...
ghc/compiler/rename/RnNames.lhs
View file @
d2cca44e
...
...
@@ -19,8 +19,7 @@ import RdrHsSyn ( RdrNameIE, RdrNameImportDecl,
RdrNameHsModule, RdrNameHsDecl
)
import RnIfaces ( getInterfaceExports, getDeclBinders,
recordLocalSlurps, checkModUsage,
outOfDate, findAndReadIface )
recordLocalSlurps, findAndReadIface )
import RnEnv
import RnMonad
...
...
@@ -59,16 +58,15 @@ getGlobalNames :: RdrNameHsModule
-> RnMG (Maybe (GlobalRdrEnv, -- Maps all in-scope things
GlobalRdrEnv, -- Maps just *local* things
Avails, -- The exported stuff
AvailEnv
,
-- Maps a name to its parent AvailInfo
AvailEnv
-- Maps a name to its parent AvailInfo
-- Just for in-scope things only
Maybe ParsedIface -- The old interface file, if any
))
-- Nothing => no need to recompile
getGlobalNames (HsModule this_mod _ exports imports decls _ mod_loc)
= -- These two fix-loops are to get the right
-- provenance information into a Name
fixRn ( \ ~(Just (rec_gbl_env, _, rec_export_avails,
_,
_)) ->
fixRn ( \ ~(Just (rec_gbl_env, _, rec_export_avails, _)) ->
let
rec_unqual_fn :: Name -> Bool -- Is this chap in scope unqualified?
...
...
@@ -132,19 +130,13 @@ getGlobalNames (HsModule this_mod _ exports imports decls _ mod_loc)
-- Found errors already, so exit now
returnRn Nothing
else
checkEarlyExit this_mod `thenRn` \ (up_to_date, old_iface) ->
if up_to_date then
-- Interface files are sufficiently unchanged
putDocRn (text "Compilation IS NOT required") `thenRn_`
returnRn Nothing
else
-- PROCESS EXPORT LISTS
exportsFromAvail this_mod exports all_avails gbl_env `thenRn` \ export_avails ->
-- ALL DONE
returnRn (Just (gbl_env, local_gbl_env, export_avails, global_avail_env
, old_iface
))
returnRn (Just (gbl_env, local_gbl_env, export_avails, global_avail_env))
)
where
all_imports = prel_imports ++ imports
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment