Commit f426eef1 authored by Ian Lynagh's avatar Ian Lynagh

Merge branch 'master' of http://darcs.haskell.org/ghc

parents 6942b112 be6810bb
......@@ -286,12 +286,16 @@ rnEtaR (RV2 { envL = envL, envR = envR, in_scope = in_scope }) bR
new_b = uniqAway in_scope bR
delBndrL, delBndrR :: RnEnv2 -> Var -> RnEnv2
delBndrL rn@(RV2 { envL = env, in_scope = in_scope }) v = rn { envL = env `delVarEnv` v, in_scope = in_scope `extendInScopeSet` v }
delBndrR rn@(RV2 { envR = env, in_scope = in_scope }) v = rn { envR = env `delVarEnv` v, in_scope = in_scope `extendInScopeSet` v }
delBndrL rn@(RV2 { envL = env, in_scope = in_scope }) v
= rn { envL = env `delVarEnv` v, in_scope = in_scope `extendInScopeSet` v }
delBndrR rn@(RV2 { envR = env, in_scope = in_scope }) v
= rn { envR = env `delVarEnv` v, in_scope = in_scope `extendInScopeSet` v }
delBndrsL, delBndrsR :: RnEnv2 -> [Var] -> RnEnv2
delBndrsL rn@(RV2 { envL = env, in_scope = in_scope }) v = rn { envL = env `delVarEnvList` v, in_scope = in_scope `extendInScopeSetList` v }
delBndrsR rn@(RV2 { envR = env, in_scope = in_scope }) v = rn { envR = env `delVarEnvList` v, in_scope = in_scope `extendInScopeSetList` v }
delBndrsL rn@(RV2 { envL = env, in_scope = in_scope }) v
= rn { envL = env `delVarEnvList` v, in_scope = in_scope `extendInScopeSetList` v }
delBndrsR rn@(RV2 { envR = env, in_scope = in_scope }) v
= rn { envR = env `delVarEnvList` v, in_scope = in_scope `extendInScopeSetList` v }
rnOccL, rnOccR :: RnEnv2 -> Var -> Var
-- ^ Look up the renaming of an occurrence in the left or right term
......
......@@ -50,7 +50,7 @@ import Type hiding ( substTy, extendTvSubst, extendTvSubstList
import Coercion hiding ( substTy, substCo, extendTvSubst, substTyVarBndr, substCoVarBndr )
import OptCoercion ( optCoercion )
import PprCore ( pprCoreBindings )
import PprCore ( pprCoreBindings, pprRules )
import Module ( Module )
import VarSet
import VarEnv
......@@ -800,7 +800,7 @@ simpleOptPgm :: DynFlags -> Module
-> IO ([CoreBind], [CoreRule], [CoreVect])
simpleOptPgm dflags this_mod binds rules vects
= do { dumpIfSet_dyn dflags Opt_D_dump_occur_anal "Occurrence analysis"
(pprCoreBindings occ_anald_binds);
(pprCoreBindings occ_anald_binds $$ pprRules rules );
; return (reverse binds', substRulesForImportedIds subst' rules, substVects subst' vects) }
where
......
......@@ -70,8 +70,8 @@ getImports dflags buf filename source_filename = do
case rdr_module of
L _ (HsModule mb_mod _ imps _ _ _) ->
let
main_loc = mkSrcLoc (mkFastString source_filename) 1 1
mod = mb_mod `orElse` L (srcLocSpan main_loc) mAIN_NAME
main_loc = srcLocSpan (mkSrcLoc (mkFastString source_filename) 1 1)
mod = mb_mod `orElse` L main_loc mAIN_NAME
(src_idecls, ord_idecls) = partition (ideclSource.unLoc) imps
-- GHC.Prim doesn't exist physically, so don't go looking for it.
......@@ -79,18 +79,20 @@ getImports dflags buf filename source_filename = do
ord_idecls
implicit_prelude = xopt Opt_ImplicitPrelude dflags
implicit_imports = mkPrelImports (unLoc mod) implicit_prelude imps
implicit_imports = mkPrelImports (unLoc mod) main_loc implicit_prelude imps
in
return (src_idecls, implicit_imports ++ ordinary_imps, mod)
mkPrelImports :: ModuleName -> Bool -> [LImportDecl RdrName]
mkPrelImports :: ModuleName
-> SrcSpan -- Attribute the "import Prelude" to this location
-> Bool -> [LImportDecl RdrName]
-> [LImportDecl RdrName]
-- Consruct the implicit declaration "import Prelude" (or not)
--
-- NB: opt_NoImplicitPrelude is slightly different to import Prelude ();
-- because the former doesn't even look at Prelude.hi for instance
-- declarations, whereas the latter does.
mkPrelImports this_mod implicit_prelude import_decls
mkPrelImports this_mod loc implicit_prelude import_decls
| this_mod == pRELUDE_NAME
|| explicit_prelude_import
|| not implicit_prelude
......@@ -112,8 +114,6 @@ mkPrelImports this_mod implicit_prelude import_decls
Nothing {- No "as" -}
Nothing {- No import list -}
loc = mkGeneralSrcSpan (fsLit "Implicit import declaration")
parseError :: SrcSpan -> Message -> IO a
parseError span err = throwOneError $ mkPlainErrMsg span err
......
......@@ -309,9 +309,12 @@ hscRnImportDecls
-- because tcRnImports will force-load any orphan modules necessary, making extra
-- instances/family instances visible (GHC #4832)
hscRnImportDecls hsc_env this_mod import_decls
= runHsc hsc_env $ ioMsgMaybe $ initTc hsc_env HsSrcFile False this_mod $
fmap tcg_rdr_env $ tcRnImports hsc_env this_mod import_decls
= runHsc hsc_env $ ioMsgMaybe $
initTc hsc_env HsSrcFile False this_mod $
fmap tcg_rdr_env $
tcRnImports hsc_env this_mod loc import_decls
where
loc = mkGeneralSrcSpan (mkFastString "In a call to hscRnImportDecls")
#endif
-- -----------------------------------------------------------------------------
......
......@@ -132,16 +132,16 @@ with yes we have gone with no for now.
\begin{code}
rnImports :: [LImportDecl RdrName]
rnImports :: SrcSpan -> [LImportDecl RdrName]
-> RnM ([LImportDecl Name], GlobalRdrEnv, ImportAvails, AnyHpcUsage)
rnImports imports
rnImports prel_imp_loc imports
-- PROCESS IMPORT DECLS
-- Do the non {- SOURCE -} ones first, so that we get a helpful
-- warning for {- SOURCE -} ones that are unnecessary
= do this_mod <- getModule
implicit_prelude <- xoptM Opt_ImplicitPrelude
let prel_imports = mkPrelImports (moduleName this_mod)
let prel_imports = mkPrelImports (moduleName this_mod) prel_imp_loc
implicit_prelude imports
(source, ordinary) = partition is_source_import imports
is_source_import (L _ (ImportDecl _ _ is_boot _ _ _ _)) = is_boot
......@@ -1393,18 +1393,20 @@ warnUnusedImportDecls gbl_env
; let usage :: [ImportDeclUsage]
usage = findImportUsage imports rdr_env (Set.elems uses)
; traceRn (ptext (sLit "Import usage") <+> ppr usage)
; traceRn (vcat [ ptext (sLit "Uses:") <+> ppr (Set.elems uses)
, ptext (sLit "Import usage") <+> ppr usage])
; ifWOptM Opt_WarnUnusedImports $
mapM_ warnUnusedImport usage
; ifDOptM Opt_D_dump_minimal_imports $
printMinimalImports usage }
where
explicit_import (L loc _) = case loc of
UnhelpfulSpan _ -> False
RealSrcSpan _ -> True
explicit_import (L _ decl) = unLoc (ideclName decl) /= pRELUDE_NAME
-- Filter out the implicit Prelude import
-- which we do not want to bleat about
-- This also filters out an *explicit* Prelude import
-- but solving that problem involves more plumbing, and
-- it just doesn't seem worth it
\end{code}
\begin{code}
......
......@@ -121,15 +121,18 @@ tcRnModule hsc_env hsc_src save_rn_syntax
= do { showPass (hsc_dflags hsc_env) "Renamer/typechecker" ;
let { this_pkg = thisPackage (hsc_dflags hsc_env) ;
this_mod = case maybe_mod of
Nothing -> mAIN -- 'module M where' is omitted
Just (L _ mod) -> mkModule this_pkg mod } ;
-- The normal case
(this_mod, prel_imp_loc)
= case maybe_mod of
Nothing -- 'module M where' is omitted
-> (mAIN, srcLocSpan (srcSpanStart loc))
Just (L mod_loc mod) -- The normal case
-> (mkModule this_pkg mod, mod_loc) } ;
initTc hsc_env hsc_src save_rn_syntax this_mod $
setSrcSpan loc $
do { -- Deal with imports;
tcg_env <- tcRnImports hsc_env this_mod import_decls ;
tcg_env <- tcRnImports hsc_env this_mod prel_imp_loc import_decls ;
setGblEnv tcg_env $ do {
-- Load the hi-boot interface for this module, if any
......@@ -199,9 +202,11 @@ tcRnModule hsc_env hsc_src save_rn_syntax
%************************************************************************
\begin{code}
tcRnImports :: HscEnv -> Module -> [LImportDecl RdrName] -> TcM TcGblEnv
tcRnImports hsc_env this_mod import_decls
= do { (rn_imports, rdr_env, imports,hpc_info) <- rnImports import_decls ;
tcRnImports :: HscEnv -> Module
-> SrcSpan -- Location for the implicit prelude import
-> [LImportDecl RdrName] -> TcM TcGblEnv
tcRnImports hsc_env this_mod prel_imp_loc import_decls
= do { (rn_imports, rdr_env, imports,hpc_info) <- rnImports prel_imp_loc import_decls ;
; let { dep_mods :: ModuleNameEnv (ModuleName, IsBootInterface)
-- Make sure we record the dependencies from the DynFlags in the EPS or we
......
......@@ -599,7 +599,10 @@ keyword = bold
class Outputable a where
ppr :: a -> SDoc
pprPrec :: Rational -> a -> SDoc
-- 0 binds least tightly
-- We use Rational because there is always a
-- Rational between any other two Rationals
ppr = pprPrec 0
pprPrec _ = ppr
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment