diff options
Diffstat (limited to 'compiler/rename')
-rw-r--r-- | compiler/rename/RnHsDoc.hs | 22 | ||||
-rw-r--r-- | compiler/rename/RnNames.lhs | 71 | ||||
-rw-r--r-- | compiler/rename/RnSource.lhs | 14 |
3 files changed, 63 insertions, 44 deletions
diff --git a/compiler/rename/RnHsDoc.hs b/compiler/rename/RnHsDoc.hs index f3d36907f4..9fb9348eb0 100644 --- a/compiler/rename/RnHsDoc.hs +++ b/compiler/rename/RnHsDoc.hs @@ -1,17 +1,29 @@ -module RnHsDoc ( rnHsDoc, rnLHsDoc, rnMbLHsDoc, rnMbHsDoc ) where +module RnHsDoc ( rnHaddock, rnHsDoc, rnLHsDoc, rnMbLHsDoc ) where +import TcRnTypes import TcRnMonad ( RnM ) import RnEnv ( dataTcOccs, lookupGreRn_maybe ) -import HsDoc ( HsDoc(..) ) +import HsSyn -import RdrName ( RdrName, isRdrDataCon, isRdrTc, gre_name ) +import RdrName ( RdrName, gre_name ) import Name ( Name ) import SrcLoc ( Located(..) ) import Outputable ( ppr, defaultUserStyle ) -import Data.List ( (\\) ) -import Debug.Trace ( trace ) +rnHaddock :: HaddockModInfo RdrName -> Maybe (HsDoc RdrName) + -> TcGblEnv -> RnM TcGblEnv +rnHaddock module_info maybe_doc tcg_env + = do { rn_module_doc <- rnMbHsDoc maybe_doc ; + + -- Rename the Haddock module info + ; rn_description <- rnMbHsDoc (hmi_description module_info) + ; let { rn_module_info = module_info { hmi_description = rn_description } } + + ; return (tcg_env { tcg_doc = rn_module_doc, + tcg_hmi = rn_module_info }) } + +rnMbHsDoc :: Maybe (HsDoc RdrName) -> RnM (Maybe (HsDoc Name)) rnMbHsDoc mb_doc = case mb_doc of Just doc -> do doc' <- rnHsDoc doc diff --git a/compiler/rename/RnNames.lhs b/compiler/rename/RnNames.lhs index 0c0982767b..6c35ef11a2 100644 --- a/compiler/rename/RnNames.lhs +++ b/compiler/rename/RnNames.lhs @@ -8,7 +8,7 @@ module RnNames ( rnImports, importsFromLocalDecls, rnExports, getLocalDeclBinders, extendRdrEnvRn, - reportUnusedNames, reportDeprecations + reportUnusedNames, finishDeprecations ) where #include "HsVersions.h" @@ -688,41 +688,44 @@ type ExportOccMap = OccEnv (Name, IE RdrName) -- it came from. It's illegal to export two distinct things -- that have the same occurrence name -rnExports :: Bool -- False => no 'module M(..) where' header at all +rnExports :: Bool -- False => no 'module M(..) where' header at all -> Maybe [LIE RdrName] -- Nothing => no explicit export list - -> RnM (Maybe [LIE Name], [AvailInfo]) + -> TcGblEnv + -> RnM TcGblEnv -- Complains if two distinct exports have same OccName -- Warns about identical exports. -- Complains about exports items not in scope -rnExports explicit_mod exports - = do TcGblEnv { tcg_mod = this_mod, - tcg_rdr_env = rdr_env, - tcg_imports = imports } <- getGblEnv - +rnExports explicit_mod exports + tcg_env@(TcGblEnv { tcg_mod = this_mod, + tcg_rdr_env = rdr_env, + tcg_imports = imports }) + = do { -- If the module header is omitted altogether, then behave -- as if the user had written "module Main(main) where..." -- EXCEPT in interactive mode, when we behave as if he had -- written "module Main where ..." -- Reason: don't want to complain about 'main' not in scope -- in interactive mode - ghc_mode <- getGhcMode - real_exports <- - case () of - () | explicit_mod - -> return exports - | ghc_mode == Interactive - -> return Nothing - | otherwise - -> do mainName <- lookupGlobalOccRn main_RDR_Unqual - return (Just ([noLoc (IEVar main_RDR_Unqual)])) - -- ToDo: the 'noLoc' here is unhelpful if 'main' turns - -- out to be out of scope - - (exp_spec, avails) <- exports_from_avail real_exports rdr_env imports this_mod - - return (exp_spec, nubAvails avails) -- Combine families + ; ghc_mode <- getGhcMode + ; let real_exports + | explicit_mod = exports + | ghc_mode == Interactive = Nothing + | otherwise = Just ([noLoc (IEVar main_RDR_Unqual)]) + -- ToDo: the 'noLoc' here is unhelpful if 'main' + -- turns out to be out of scope + + ; (rn_exports, avails) <- exports_from_avail real_exports rdr_env imports this_mod + ; let final_avails = nubAvails avails -- Combine families + + ; return (tcg_env { tcg_exports = final_avails, + tcg_rn_exports = case tcg_rn_exports tcg_env of + Nothing -> Nothing + Just _ -> rn_exports, + tcg_dus = tcg_dus tcg_env `plusDU` + usesOnly (availsToNameSet final_avails) }) } + exports_from_avail :: Maybe [LIE RdrName] -- Nothing => no explicit export list @@ -904,13 +907,23 @@ check_occs ie occs names %********************************************************* \begin{code} -reportDeprecations :: DynFlags -> TcGblEnv -> RnM () -reportDeprecations dflags tcg_env - = ifOptM Opt_WarnDeprecations $ - do { (eps,hpt) <- getEpsAndHpt +finishDeprecations :: DynFlags -> Maybe DeprecTxt + -> TcGblEnv -> RnM TcGblEnv +-- (a) Report usasge of deprecated imports +-- (b) If the whole module is deprecated, update tcg_deprecs +-- All this happens only once per module +finishDeprecations dflags mod_deprec tcg_env + = do { (eps,hpt) <- getEpsAndHpt + ; ifOptM Opt_WarnDeprecations $ + mapM_ (check hpt (eps_PIT eps)) all_gres -- By this time, typechecking is complete, -- so the PIT is fully populated - ; mapM_ (check hpt (eps_PIT eps)) all_gres } + + -- Deal with a module deprecation; it overrides all existing deprecs + ; let new_deprecs = case mod_deprec of + Just txt -> DeprecAll txt + Nothing -> tcg_deprecs tcg_env + ; return (tcg_env { tcg_deprecs = new_deprecs }) } where used_names = allUses (tcg_dus tcg_env) -- Report on all deprecated uses; hence allUses diff --git a/compiler/rename/RnSource.lhs b/compiler/rename/RnSource.lhs index 75af8fdfd0..ca237ddfe1 100644 --- a/compiler/rename/RnSource.lhs +++ b/compiler/rename/RnSource.lhs @@ -6,7 +6,7 @@ \begin{code} module RnSource ( rnSrcDecls, addTcgDUs, - rnTyClDecls, checkModDeprec, + rnTyClDecls, rnSplice, checkTH ) where @@ -23,7 +23,7 @@ import RnTypes ( rnLHsType, rnLHsTypes, rnHsSigType, rnHsTypeFVs, rnContext ) import RnBinds ( rnTopBinds, rnMethodBinds, renameSigs, mkSigTvFn ) import RnEnv ( lookupLocalDataTcNames, lookupLocatedTopBndrRn, lookupLocatedOccRn, - lookupOccRn, lookupTopBndrRn, newLocalsRn, + lookupOccRn, newLocalsRn, bindLocatedLocalsFV, bindPatSigTyVarsFV, bindTyVarsRn, extendTyVarEnvFVRn, bindLocalNames, checkDupNames, mapFvRn @@ -31,8 +31,7 @@ import RnEnv ( lookupLocalDataTcNames, import RnHsDoc ( rnHsDoc, rnMbLHsDoc ) import TcRnMonad -import HscTypes ( FixityEnv, FixItem(..), - Deprecations, Deprecs(..), DeprecTxt, plusDeprecs ) +import HscTypes ( FixityEnv, FixItem(..), Deprecations, Deprecs(..), plusDeprecs ) import Class ( FunDep ) import Name ( Name, nameOccName ) import NameSet @@ -42,7 +41,7 @@ import Outputable import SrcLoc ( Located(..), unLoc, noLoc ) import DynFlags ( DynFlag(..) ) import Maybes ( seqMaybe ) -import Maybe ( isNothing, isJust ) +import Maybe ( isNothing ) import Monad ( liftM, when ) import BasicTypes ( Boxity(..) ) \end{code} @@ -254,11 +253,6 @@ rnSrcDeprecDecls decls rn_deprec (Deprecation rdr_name txt) = lookupLocalDataTcNames rdr_name `thenM` \ names -> returnM [(name, (nameOccName name, txt)) | name <- names] - -checkModDeprec :: Maybe DeprecTxt -> Deprecations --- Check for a module deprecation; done once at top level -checkModDeprec Nothing = NoDeprecs -checkModDeprec (Just txt) = DeprecAll txt \end{code} %********************************************************* |