Commit 2ecf1c9f authored by simonpj's avatar simonpj
Browse files

[project @ 2000-10-30 09:52:14 by simonpj]

First steps to making it work
parent 73c0472d
# -----------------------------------------------------------------------------
# $Id: Makefile,v 1.101 2000/10/27 16:30:02 simonmar Exp $
# $Id: Makefile,v 1.102 2000/10/30 09:52:14 simonpj Exp $
TOP = ..
include $(TOP)/mk/boilerplate.mk
......@@ -366,7 +366,7 @@ parser/Parser.hs : parser/Parser.y
#-----------------------------------------------------------------------------
# Linking
SRC_LD_OPTS += -no-link-chk -ldl
SRC_LD_OPTS += -no-link-chk
ifneq "$(GhcWithHscBuiltViaC)" "YES"
ifeq "$(GhcReportCompiles)" "YES"
......
......@@ -16,7 +16,8 @@ module Name (
nameUnique, setNameUnique, setLocalNameSort,
tidyTopName,
nameOccName, nameModule, setNameOcc, nameRdrName, setNameModuleAndLoc,
nameOccName, nameModule, nameModule_maybe,
setNameOcc, nameRdrName, setNameModuleAndLoc,
toRdrName, hashName,
isUserExportedName,
......@@ -43,13 +44,10 @@ module Name (
import OccName -- All of it
import Module ( Module, moduleName, mkVanillaModule,
printModulePrefix, isModuleInThisPackage )
import RdrName ( RdrName, mkRdrQual, mkRdrUnqual, rdrNameOcc,
rdrNameModule )
import CmdLineOpts ( opt_Static, opt_PprStyle_NoPrags,
opt_OmitInterfacePragmas, opt_EnsureSplittableC )
import RdrName ( RdrName, mkRdrQual, mkRdrUnqual, rdrNameOcc, rdrNameModule )
import CmdLineOpts ( opt_Static, opt_OmitInterfacePragmas, opt_EnsureSplittableC )
import SrcLoc ( builtinSrcLoc, noSrcLoc, SrcLoc )
import Unique ( Unique, Uniquable(..), u2i, pprUnique )
import Unique ( Unique, Uniquable(..), u2i, pprUnique, pprUnique10 )
import Maybes ( expectJust )
import FastTypes
import UniqFM
......@@ -114,8 +112,12 @@ nameSrcLoc :: Name -> SrcLoc
nameUnique name = n_uniq name
nameOccName name = n_occ name
nameSrcLoc name = n_loc name
nameModule (Name { n_sort = Global mod }) = mod
nameModule name = pprPanic "nameModule" (ppr name)
nameModule_maybe (Name { n_sort = Global mod }) = Just mod
nameModule_maybe name = Nothing
\end{code}
\begin{code}
......@@ -297,16 +299,23 @@ are exported. But also:
\begin{code}
tidyTopName :: Module -> TidyOccEnv -> Name -> (TidyOccEnv, Name)
tidyTopName mod env name
= (env', name')
tidyTopName mod env
name@(Name { n_occ = occ, n_sort = sort, n_uniq = uniq, n_loc = loc })
= case sort of
System -> localise -- System local Ids
Local -> localise -- User non-exported Ids
Exported -> globalise -- User-exported things
Global _ -> no_op -- Constructors, class selectors etc
where
(env', occ') = tidyOccName env (n_occ name)
no_op = (env, name)
name' = Name { n_uniq = n_uniq name, n_sort = mk_top_sort mod,
n_occ = occ', n_loc = n_loc name }
globalise = (env, name { n_sort = Global mod }) -- Don't change occurrence name
mk_top_sort mod | all_toplev_ids_visible = Global mod
| otherwise = Local
localise = (env', name')
(env', occ') = tidyOccName env occ
name' | all_toplev_ids_visible = name { n_occ = occ', n_sort = Global mod }
| otherwise = name { n_occ = occ' }
all_toplev_ids_visible =
not opt_OmitInterfacePragmas || -- Pragmas can make them visible
......@@ -437,24 +446,28 @@ instance Outputable Name where
pprName (Name {n_sort = sort, n_uniq = uniq, n_occ = occ})
= getPprStyle $ \ sty ->
let local | debugStyle sty
= pprOccName occ <> text "{-" <> pprUnique uniq <> text "-}"
| codeStyle sty
= pprUnique uniq
| otherwise
= pprOccName occ
global m | codeStyle sty
= ppr (moduleName m) <> char '_' <> pprOccName occ
| debugStyle sty || printModulePrefix m
= ppr (moduleName m) <> dot <> pprOccName occ
| otherwise
= pprOccName occ
in case sort of
System -> local
Local -> local
Exported -> local
Global mod -> global mod
case sort of
Global mod -> pprGlobal sty uniq mod occ
System -> pprSysLocal sty uniq occ
Local -> pprLocal sty uniq occ empty
Exported -> pprLocal sty uniq occ (char 'x')
pprLocal sty uniq occ pp_export
| codeStyle sty = pprUnique uniq
| debugStyle sty = pprOccName occ <>
text "{-" <> pp_export <+> pprUnique10 uniq <> text "-}"
| otherwise = pprOccName occ
pprGlobal sty uniq mod occ
| codeStyle sty = ppr (moduleName mod) <> char '_' <> pprOccName occ
| debugStyle sty = ppr (moduleName mod) <> dot <> pprOccName occ <>
text "{-" <> pprUnique10 uniq <> text "-}"
| printModulePrefix mod = ppr (moduleName mod) <> dot <> pprOccName occ
| otherwise = pprOccName occ
pprSysLocal sty uniq occ
| codeStyle sty = pprUnique uniq
| otherwise = pprOccName occ <> char '_' <> pprUnique uniq
\end{code}
......
......@@ -133,4 +133,5 @@ instance Outputable SrcLoc where
-- so emacs can find the file
ppr (UnhelpfulSrcLoc s) = ptext s
ppr NoSrcLoc = ptext SLIT("<No locn>")
\end{code}
......@@ -215,8 +215,7 @@ tidyTopId :: Module -> TidyEnv -> TidyEnv -> Id -> (TidyEnv, Id)
tidyTopId mod env@(tidy_env, var_env) env_idinfo id
= -- Top level variables
let
(tidy_env', name') | exportWithOrigOccName id = (tidy_env, idName id)
| otherwise = tidyTopName mod tidy_env (idName id)
(tidy_env', name') = tidyTopName mod tidy_env (idName id)
ty' = tidyTopType (idType id)
idinfo' = tidyIdInfo env_idinfo (idInfo id)
id' = mkId name' ty' idinfo'
......
......@@ -238,13 +238,13 @@ tyClDeclNames :: Eq name => TyClDecl name pat -> [(name, SrcLoc)]
tyClDeclNames (TySynonym name _ _ loc)
= [(name,loc)]
tyClDeclNames (ClassDecl _ name _ _ sigs _ _ loc)
= (name,loc) : [(name,loc) | ClassOpSig n _ _ loc <- sigs]
tyClDeclNames (ClassDecl _ cls_name _ _ sigs _ _ loc)
= (cls_name,loc) : [(n,loc) | ClassOpSig n _ _ loc <- sigs]
tyClDeclNames (TyData _ _ name _ cons _ _ loc _ _)
= (name,loc) : conDeclsNames cons
tyClDeclNames (TyData _ _ tc_name _ cons _ _ loc _ _)
= (tc_name,loc) : conDeclsNames cons
tyClDeclNames (IfaceSig _ _ _ _) = []
tyClDeclNames (IfaceSig name _ _ loc) = [(name,loc)]
type ClassDeclSysNames name = [name]
-- [tycon, datacon wrapper, datacon worker,
......
......@@ -34,38 +34,43 @@ source, interface, and object files for a module live.
\begin{code}
-- caches contents of package directories, never expunged
-- v_PkgDirCache caches contents of package directories, never expunged
GLOBAL_VAR(v_PkgDirCache, error "no pkg cache!", FiniteMap String (PackageName, FilePath))
-- caches contents of home directories, expunged whenever we
-- create a new finder.
-- v_HomeDirCache caches contents of home directories,
-- expunged whenever we create a new finder.
GLOBAL_VAR(v_HomeDirCache, Nothing, Maybe (FiniteMap String FilePath))
initFinder :: PackageConfigInfo -> IO ()
initFinder pkgs = do
-- expunge our home cache
writeIORef v_HomeDirCache Nothing
-- lazilly fill in the package cache
writeIORef v_PkgDirCache (unsafePerformIO (newPkgCache pkgs))
pkg_dbg_info <- readIORef v_PkgDirCache
putStrLn (unlines (map show (fmToList pkg_dbg_info)))
initFinder pkgs
= do { -- expunge our home cache
; writeIORef v_HomeDirCache Nothing
-- lazilly fill in the package cache
; writeIORef v_PkgDirCache (unsafePerformIO (newPkgCache pkgs))
-- Debug output
-- ; pkg_dbg_info <- readIORef v_PkgDirCache
-- ; putStrLn (unlines (map show (fmToList pkg_dbg_info)))
}
findModule :: ModuleName -> IO (Maybe (Module, ModuleLocation))
findModule name = do
hPutStr stderr ("findModule: " ++ moduleNameUserString name ++ " ... ")
maybe_m <- findModule_wrk name
case maybe_m of
Nothing -> hPutStrLn stderr "Not Found"
Just mm -> hPutStrLn stderr (showSDoc (ppr (snd mm)))
return maybe_m
findModule name
= do { hPutStr stderr ("findModule: " ++ moduleNameUserString name ++ " ... ")
; maybe_m <- findModule_wrk name
; case maybe_m of
Nothing -> hPutStrLn stderr "Not Found"
Just mm -> hPutStrLn stderr (showSDoc (ppr (snd mm)))
; return maybe_m
}
findModule_wrk :: ModuleName -> IO (Maybe (Module, ModuleLocation))
findModule_wrk name = do
j <- maybeHomeModule name
case j of
Just home_module -> return (Just home_module)
Nothing -> maybePackageModule name
findModule_wrk name
= do { j <- maybeHomeModule name
; case j of
Just home_module -> return (Just home_module)
Nothing -> maybePackageModule name
}
maybeHomeModule :: ModuleName -> IO (Maybe (Module, ModuleLocation))
maybeHomeModule mod_name = do
......
......@@ -10,13 +10,9 @@ module HscMain ( HscResult(..), hscMain,
#include "HsVersions.h"
import Maybe ( isJust )
import Monad ( when )
import IO ( hPutStr, hPutStrLn, hClose, stderr,
openFile, IOMode(..) )
import IO ( hPutStr, hPutStrLn, stderr )
import HsSyn
import RdrHsSyn ( RdrNameHsModule )
import FastString ( unpackFS )
import StringBuffer ( hGetStringBuffer )
import Parser ( parse )
import Lex ( PState(..), ParseResult(..) )
......@@ -31,7 +27,6 @@ import PrelRules ( builtinRules )
import MkIface ( completeIface, mkModDetailsFromIface, mkModDetails,
writeIface )
import TcModule ( TcResults(..), typecheckModule )
import TcEnv ( tcEnvTyCons, tcEnvClasses )
import InstEnv ( emptyInstEnv )
import Desugar ( deSugar )
import SimplCore ( core2core )
......@@ -44,36 +39,28 @@ import SimplStg ( stg2stg )
import CodeGen ( codeGen )
import CodeOutput ( codeOutput )
import Module ( ModuleName, moduleNameUserString,
moduleUserString, moduleName, emptyModuleEnv,
extendModuleEnv )
import Module ( ModuleName, moduleName, emptyModuleEnv )
import CmdLineOpts
import ErrUtils ( ghcExit, doIfSet, dumpIfSet_dyn )
import ErrUtils ( dumpIfSet_dyn )
import UniqSupply ( mkSplitUniqSupply )
import Bag ( emptyBag )
import Outputable
import Char ( isSpace )
import StgInterp ( stgToInterpSyn )
import HscStats ( ppSourceStats )
import HscTypes ( ModDetails, ModIface(..), PersistentCompilerState(..),
PersistentRenamerState(..), WhatsImported(..),
HomeSymbolTable, PackageSymbolTable, ImportVersion,
GenAvailInfo(..), RdrAvailInfo, OrigNameEnv(..),
PackageRuleBase, HomeIfaceTable, PackageIfaceTable,
extendTypeEnv, groupTyThings, TypeEnv, TyThing,
PersistentRenamerState(..),
HomeSymbolTable, PackageSymbolTable,
OrigNameEnv(..), PackageRuleBase, HomeIfaceTable,
extendTypeEnv, groupTyThings,
typeEnvClasses, typeEnvTyCons, emptyIfaceTable )
import RnMonad ( ExportItem, ParsedIface(..) )
import CmSummarise ( ModSummary(..), name_of_summary, ms_get_imports,
mimp_name )
import CmSummarise ( ModSummary(..), ms_get_imports, mimp_name )
import InterpSyn ( UnlinkedIBind )
import StgInterp ( ItblEnv )
import FiniteMap ( FiniteMap, plusFM, emptyFM, addToFM )
import OccName ( OccName, pprOccName )
import Name ( Name, nameModule, emptyNameEnv, nameOccName,
getName, extendNameEnv_C, nameEnvElts )
import VarEnv ( emptyVarEnv )
import Module ( Module, mkModuleName, lookupModuleEnvByName )
import OccName ( OccName )
import Name ( Name, nameModule, emptyNameEnv, nameOccName, getName )
import Module ( Module, lookupModuleEnvByName )
\end{code}
......@@ -152,7 +139,6 @@ hscNoRecomp dflags summary maybe_checked_iface hst hit pcs_ch
let pcs_tc = tc_pcs tc_result
env_tc = tc_env tc_result
binds_tc = tc_binds tc_result
local_insts = tc_insts tc_result
local_rules = tc_rules tc_result
;
......@@ -192,12 +178,12 @@ hscRecomp dflags summary maybe_checked_iface hst hit pcs_ch
maybe_tc_result
<- typecheckModule dflags this_mod pcs_rn hst hit rn_hs_decls;
case maybe_tc_result of {
Nothing -> return (HscFail pcs_rn);
Nothing -> do { hPutStrLn stderr "Typechecked failed"
; return (HscFail pcs_rn) } ;
Just tc_result -> do {
let pcs_tc = tc_pcs tc_result
env_tc = tc_env tc_result
binds_tc = tc_binds tc_result
local_insts = tc_insts tc_result
;
-- DESUGAR, SIMPLIFY, TIDY-CORE
......
......@@ -308,14 +308,12 @@ data Deprecations = NoDeprecs
-- Just "big" names
-- We keep the Name in the range, so we can print them out
lookupDeprec :: ModIface -> Name -> Maybe DeprecTxt
lookupDeprec iface name
= case mi_deprecs iface of
NoDeprecs -> Nothing
DeprecAll txt -> Just txt
DeprecSome env -> case lookupNameEnv env name of
Just (_, txt) -> Just txt
Nothing -> Nothing
lookupDeprec :: Deprecations -> Name -> Maybe DeprecTxt
lookupDeprec NoDeprecs name = Nothing
lookupDeprec (DeprecAll txt) name = Just txt
lookupDeprec (DeprecSome env) name = case lookupNameEnv env name of
Just (_, txt) -> Just txt
Nothing -> Nothing
type InstEnv = UniqFM ClsInstEnv -- Maps Class to instances for that class
......
-----------------------------------------------------------------------------
-- $Id: TmpFiles.hs,v 1.7 2000/10/27 15:11:37 sewardj Exp $
-- $Id: TmpFiles.hs,v 1.8 2000/10/30 09:52:15 simonpj Exp $
--
-- Temporary file management
--
......@@ -47,12 +47,12 @@ cleanTempFiles verbose = do
fs <- readIORef v_FilesToClean
let blowAway f =
(do when verbose (hPutStrLn stderr ("removing: " ++ f))
(do when verbose (hPutStrLn stderr ("Removing: " ++ f))
if '*' `elem` f then system ("rm -f " ++ f) >> return ()
else removeFile f)
`catchAllIO`
(\_ -> when verbose (hPutStrLn stderr
("warning: can't remove tmp file" ++ f)))
("Warning: can't remove tmp file " ++ f)))
mapM_ blowAway fs
type Suffix = String
......
......@@ -10,7 +10,7 @@ module Rename ( renameModule, closeIfaceDecls, checkOldIface ) where
import HsSyn
import RdrHsSyn ( RdrNameHsModule, RdrNameHsDecl, RdrNameDeprecation,
RdrNameTyClDecl, RdrNameRuleDecl, RdrNameInstDecl
RdrNameTyClDecl, RdrNameRuleDecl, RdrNameInstDecl, RdrNameImportDecl
)
import RnHsSyn ( RenamedHsDecl, RenamedTyClDecl, RenamedRuleDecl, RenamedInstDecl,
extractHsTyNames,
......@@ -26,24 +26,24 @@ import RnIfaces ( slurpImpDecls, mkImportInfo,
RecompileRequired, recompileRequired
)
import RnHiFiles ( findAndReadIface, removeContext, loadExports, loadFixDecls, loadDeprecs )
import RnEnv ( availName, availsToNameSet,
import RnEnv ( availName,
emptyAvailEnv, unitAvailEnv, availEnvElts, plusAvailEnv, groupAvails,
warnUnusedImports, warnUnusedLocalBinds, warnUnusedModules,
lookupOrigNames, lookupGlobalRn, newGlobalName
)
import Module ( Module, ModuleName, WhereFrom(..),
moduleNameUserString, moduleName,
lookupModuleEnv
moduleNameUserString, moduleName
)
import Name ( Name, isLocallyDefined, NamedThing(..), getSrcLoc,
nameOccName, nameModule,
mkNameEnv, nameEnvElts, extendNameEnv
)
import RdrName ( elemRdrEnv )
import OccName ( occNameFlavour )
import NameSet
import TysWiredIn ( unitTyCon, intTyCon, boolTyCon )
import PrelNames ( mAIN_Name, pREL_MAIN_Name, pRELUDE_Name,
ioTyCon_RDR,
ioTyCon_RDR, main_RDR,
unpackCString_RDR, unpackCStringFoldr_RDR, unpackCStringUtf8_RDR,
eqString_RDR
)
......@@ -61,9 +61,9 @@ import IO ( openFile, IOMode(..) )
import HscTypes ( PersistentCompilerState, HomeIfaceTable, HomeSymbolTable,
ModIface(..), WhatsImported(..),
VersionInfo(..), ImportVersion, IfaceDecls(..),
GlobalRdrEnv, AvailEnv, Avails, GenAvailInfo(..), AvailInfo,
GlobalRdrEnv, AvailEnv, GenAvailInfo(..), AvailInfo,
Provenance(..), ImportReason(..), initialVersionInfo,
Deprecations(..), lookupDeprec
Deprecations(..), lookupDeprec, lookupTable
)
import List ( partition, nub )
\end{code}
......@@ -100,18 +100,21 @@ renameModule dflags hit hst old_pcs this_module rdr_module
\begin{code}
rename :: Module -> RdrNameHsModule -> RnMG (Maybe (ModIface, [RenamedHsDecl]))
rename this_module this_mod@(HsModule mod_name vers exports imports local_decls mod_deprec loc)
= -- FIND THE GLOBAL NAME ENVIRONMENT
getGlobalNames this_mod `thenRn` \ maybe_stuff ->
rename this_module contents@(HsModule _ _ _ imports local_decls mod_deprec loc)
= pushSrcLocRn loc $
-- CHECK FOR EARLY EXIT
case maybe_stuff of {
Nothing -> -- Everything is up to date; no need to recompile further
rnDump [] [] `thenRn_`
returnRn Nothing ;
Just (gbl_env, local_gbl_env, export_avails, global_avail_env) ->
-- FIND THE GLOBAL NAME ENVIRONMENT
getGlobalNames this_module contents `thenRn` \ (gbl_env, local_gbl_env,
export_avails, global_avail_env) ->
-- Exit if we've found any errors
checkErrsRn `thenRn` \ no_errs_so_far ->
if not no_errs_so_far then
-- Found errors already, so exit now
rnDump [] [] `thenRn_`
returnRn Nothing
else
-- DEAL WITH DEPRECATIONS
rnDeprecs local_gbl_env mod_deprec
[d | DeprecD d <- local_decls] `thenRn` \ my_deprecs ->
......@@ -124,6 +127,9 @@ rename this_module this_mod@(HsModule mod_name vers exports imports local_decls
rnSourceDecls local_decls
) `thenRn` \ (rn_local_decls, source_fvs) ->
-- CHECK THAT main IS DEFINED, IF REQUIRED
checkMain this_module local_gbl_env `thenRn_`
-- SLURP IN ALL THE NEEDED DECLARATIONS
implicitFVs mod_name rn_local_decls `thenRn` \ implicit_fvs ->
let
......@@ -157,9 +163,6 @@ rename this_module this_mod@(HsModule mod_name vers exports imports local_decls
getNameSupplyRn `thenRn` \ name_supply ->
getIfacesRn `thenRn` \ ifaces ->
let
direct_import_mods :: [ModuleName]
direct_import_mods = nub [m | ImportDecl m _ _ _ _ _ <- imports]
-- We record fixities even for things that aren't exported,
-- so that we can change into the context of this moodule easily
fixities = mkNameEnv [ (name, fixity)
......@@ -168,7 +171,7 @@ rename this_module this_mod@(HsModule mod_name vers exports imports local_decls
-- Sort the exports to make them easier to compare for versions
my_exports = groupAvails export_avails
my_exports = groupAvails this_module export_avails
mod_iface = ModIface { mi_module = this_module,
mi_version = initialVersionInfo,
......@@ -185,13 +188,23 @@ rename this_module this_mod@(HsModule mod_name vers exports imports local_decls
in
-- REPORT UNUSED NAMES, AND DEBUG DUMP
reportUnusedNames mod_name direct_import_mods
gbl_env global_avail_env
export_avails source_fvs
rn_imp_decls `thenRn_`
reportUnusedNames mod_iface imports global_avail_env
real_source_fvs rn_imp_decls `thenRn_`
returnRn (Just (mod_iface, final_decls))
}
where
mod_name = moduleName this_module
\end{code}
Checking that main is defined
\begin{code}
checkMain :: Module -> GlobalRdrEnv -> RnMG ()
checkMain this_mod local_env
| moduleName this_mod == mAIN_Name
= checkRn (main_RDR `elemRdrEnv` local_env) noMainErr
| otherwise
= returnRn ()
\end{code}
@implicitFVs@ forces the renamer to slurp in some things which aren't
......@@ -508,23 +521,22 @@ closeIfaceDecls dflags hit hst pcs
%*********************************************************
\begin{code}
reportUnusedNames :: ModuleName -> [ModuleName]
-> GlobalRdrEnv -> AvailEnv
-> Avails -> NameSet -> [RenamedHsDecl]
reportUnusedNames :: ModIface -> [RdrNameImportDecl]
-> AvailEnv
-> NameSet
-> [RenamedHsDecl]
-> RnMG ()
reportUnusedNames mod_name direct_import_mods
gbl_env avail_env
export_avails mentioned_names
imported_decls
reportUnusedNames my_mod_iface imports avail_env
used_names imported_decls
= warnUnusedModules unused_imp_mods `thenRn_`
warnUnusedLocalBinds bad_locals `thenRn_`
warnUnusedImports bad_imp_names `thenRn_`
printMinimalImports mod_name minimal_imports `thenRn_`
warnDeprecations really_used_names `thenRn_`
printMinimalImports my_mod_iface minimal_imports `thenRn_`
warnDeprecations my_mod_iface really_used_names `thenRn_`
returnRn ()
where
used_names = mentioned_names `unionNameSets` availsToNameSet export_avails
gbl_env = mi_globals my_mod_iface
-- Now, a use of C implies a use of T,
-- if C was brought into scope by T(..) or T(C)
......@@ -603,7 +615,10 @@ reportUnusedNames mod_name direct_import_mods
| otherwise = addToFM acc m emptyAvailEnv
-- Add an empty collection of imports for a module
-- from which we have sucked only instance decls
direct_import_mods :: [ModuleName]
direct_import_mods = nub [m | ImportDecl m _ _ _ _ _ <- imports]
-- unused_imp_mods are the directly-imported modules
-- that are not mentioned in minimal_imports
unused_imp_mods = [m | m <- direct_import_mods,
......@@ -614,7 +629,7 @@ reportUnusedNames mod_name direct_import_mods
module_unused mod = moduleName mod `elem` unused_imp_mods
warnDeprecations used_names
warnDeprecations my_mod_iface used_names
= doptRn Opt_WarnDeprecations `thenRn` \ warn_drs ->
if not warn_drs then returnRn () else
......@@ -629,17 +644,16 @@ warnDeprecations used_names
mapRn_ warnDeprec deprecs
where
lookup_deprec hit pit n
= case lookupModuleEnv hit mod of
Just iface -> lookupDeprec iface n
Nothing -> case lookupModuleEnv pit mod of
Just iface -> lookupDeprec iface n
Nothing -> pprPanic "warnDeprecations:" (ppr n)
where
mod = nameModule n
mod = mi_module my_mod_iface
my_deprecs = mi_deprecs my_mod_iface
lookup_deprec hit pit n
| isLocalThing mod n = lookupDeprec my_deprecs n
| otherwise = case lookupTable hit pit n of
Just iface -> lookupDeprec (mi_deprecs iface) n
Nothing -> pprPanic "warnDeprecations:" (ppr n)
-- ToDo: deal with original imports with 'qualified' and 'as M' clauses
printMinimalImports mod_name imps
printMinimalImports my_mod_iface imps
= doptRn Opt_D_dump_minimal_imports `thenRn` \ dump_minimal ->
if not dump_minimal then returnRn () else
......@@ -649,7 +663,8 @@ printMinimalImports mod_name imps
}) `thenRn_`
returnRn ()
where
filename = moduleNameUserString mod_name ++ ".imports"
filename = moduleNameUserString (moduleName (mi_module my_mod_iface))
++ ".imports"
ppr_mod_ie (mod_name, ies)
| mod_name == pRELUDE_Name
= empty
......@@ -786,6 +801,10 @@ dupFixityDecl rdr_name loc1 loc2
badDeprec d
= sep [ptext SLIT("Illegal deprecation when whole module is deprecated"),
nest 4 (ppr d)]
noMainErr
= hsep [ptext SLIT("Module"), quotes (ppr mAIN_Name),
ptext SLIT("must include a definition for"), quotes (ptext SLIT("main"))]
\end{code}
......@@ -21,7 +21,7 @@ import RnMonad
import Name ( Name, NamedThing(..),
getSrcLoc,
mkLocalName, mkImportedLocalName, mkGlobalName,
mkIPName, nameOccName, nameModule,
mkIPName, nameOccName, nameModule_maybe,
extendNameEnv_C, plusNameEnv_C, nameEnvElts,
setNameModuleAndLoc
)
......@@ -49,10 +49,25 @@ import FastString ( FastString )
\begin{code}
newTopBinder :: Module -> RdrName -> SrcLoc -> RnM d Name
-- newTopBinder puts into the cache the binder with the
-- module information set correctly. When the decl is later renamed,
-- the binding site will thereby get the correct module.
-- There maybe occurrences that don't have the correct Module, but
-- by the typechecker will propagate the binding definition to all
-- the occurrences, so that doesn't matter
newTopBinder mod rdr_name loc
= -- First check the cache
traceRn (text "newTopBinder" <+> ppr mod <+> ppr loc) `thenRn_`
-- There should never be a qualified name in a binding position (except in instance decls)
-- The parser doesn't check this because the same parser parses instance decls
(if isQual rdr_name then
qualNameErr (text "its declaration") (rdr_name,loc)
else
returnRn ()
) `thenRn_`
getNameSupplyRn `thenRn` \ (us, cache, ipcache) ->
let
occ = rdrNameOcc rdr_name
......@@ -639,10 +654,10 @@ filterAvail (IEThingAll _) avail@(AvailTC _ _) = Just avail
filterAvail ie avail = Nothing
-------------------------------------
groupAvails :: Avails -> [(ModuleName, Avails)]
groupAvails :: Module -> Avails -> [(ModuleName, Avails)]