X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Frename%2FRnEnv.lhs;h=4d2ee53892303ae7011d5f7ba13938e314e09221;hp=c5b1a8c5cf2913f00d0fc7d4c4b21ad7dfea75c5;hb=4385caba003064bb556f965b32fdc962ea19ea69;hpb=7f2909e06884a04199131407c12ba179d5886f46 diff --git a/compiler/rename/RnEnv.lhs b/compiler/rename/RnEnv.lhs index c5b1a8c..4d2ee53 100644 --- a/compiler/rename/RnEnv.lhs +++ b/compiler/rename/RnEnv.lhs @@ -4,83 +4,87 @@ \section[RnEnv]{Environment manipulation for the renamer monad} \begin{code} -{-# OPTIONS -w #-} --- The above warning supression flag is a temporary kludge. --- While working on this module you are encouraged to remove it and fix --- any warnings in the module. See --- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings --- for details - module RnEnv ( newTopSrcBinder, lookupFamInstDeclBndr, lookupLocatedBndrRn, lookupBndrRn, lookupBndrRn_maybe, - lookupLocatedTopBndrRn, lookupTopBndrRn, lookupBndrRn_maybe, + lookupLocatedTopBndrRn, lookupTopBndrRn, lookupLocatedOccRn, lookupOccRn, lookupLocatedGlobalOccRn, lookupGlobalOccRn, lookupLocalDataTcNames, lookupSrcOcc_maybe, - lookupFixityRn, lookupTyFixityRn, lookupLocatedSigOccRn, + lookupFixityRn, lookupTyFixityRn, lookupInstDeclBndr, lookupRecordBndr, lookupConstructorFields, lookupSyntaxName, lookupSyntaxTable, lookupImportedName, lookupGreRn, lookupGreLocalRn, lookupGreRn_maybe, getLookupOccRn, newLocalsRn, newIPNameRn, - bindLocalNames, bindLocalNamesFV, bindLocalNamesFV_WithFixities, + bindLocalNames, bindLocalNamesFV, + MiniFixityEnv, emptyFsEnv, extendFsEnv, lookupFsEnv, + bindLocalNamesFV_WithFixities, bindLocatedLocalsFV, bindLocatedLocalsRn, bindSigTyVarsFV, bindPatSigTyVars, bindPatSigTyVarsFV, bindTyVarsRn, extendTyVarEnvFVRn, - bindLocalFixities, - checkDupNames, checkShadowing, mapFvRn, mapFvRnCPS, + checkDupRdrNames, checkDupNames, checkShadowedNames, + checkDupAndShadowedRdrNames, + mapFvRn, mapFvRnCPS, warnUnusedMatches, warnUnusedModules, warnUnusedImports, warnUnusedTopBinds, warnUnusedLocalBinds, - dataTcOccs, unknownNameErr, + dataTcOccs, unknownNameErr ) where #include "HsVersions.h" import LoadIface ( loadInterfaceForName, loadSrcInterface ) import IfaceEnv ( lookupOrig, newGlobalBinder, newIPName ) -import HsSyn ( FixitySig(..), HsExpr(..), SyntaxExpr, SyntaxTable, - LHsTyVarBndr, LHsType, - Fixity, hsLTyVarLocNames, replaceTyVarName ) +import HsSyn import RdrHsSyn ( extractHsTyRdrTyVars ) -import RdrName ( RdrName, isQual, isUnqual, isOrig_maybe, - isQual_maybe, - mkRdrUnqual, setRdrNameSpace, rdrNameOcc, - pprGlobalRdrEnv, lookupGRE_RdrName, - isExact_maybe, isSrcRdrName, - Parent(..), - GlobalRdrElt(..), GlobalRdrEnv, lookupGlobalRdrEnv, - isLocalGRE, extendLocalRdrEnv, elemLocalRdrEnv, lookupLocalRdrEnv, - Provenance(..), pprNameProvenance, - importSpecLoc, importSpecModule - ) +import RdrName import HscTypes ( availNames, ModIface(..), FixItem(..), lookupFixity) import TcEnv ( tcLookupDataCon ) import TcRnMonad import Name ( Name, nameIsLocalOrFrom, mkInternalName, isWiredInName, - nameSrcLoc, nameOccName, nameModule, isExternalName ) + nameSrcLoc, nameSrcSpan, nameOccName, nameModule, isExternalName ) import NameSet import NameEnv -import UniqFM +import LazyUniqFM import DataCon ( dataConFieldLabels ) -import OccName ( tcName, isDataOcc, pprNonVarNameSpace, occNameSpace, - reportIfUnused, occNameFS ) +import OccName import Module ( Module, ModuleName ) -import PrelNames ( mkUnboundName, rOOT_MAIN, iNTERACTIVE, consDataConKey, hasKey ) +import PrelNames ( mkUnboundName, rOOT_MAIN, iNTERACTIVE, + consDataConKey, hasKey, forall_tv_RDR ) import UniqSupply import BasicTypes ( IPName, mapIPName, Fixity ) -import SrcLoc ( SrcSpan, srcSpanStart, Located(..), eqLocated, unLoc, - srcLocSpan, getLoc, combineSrcSpans, isOneLineSpan ) +import SrcLoc import Outputable import Util import Maybes import ListSetOps ( removeDups ) import List ( nubBy ) -import Monad ( when ) import DynFlags import FastString +import Control.Monad +\end{code} + +\begin{code} +-- XXX +thenM :: Monad a => a b -> (b -> a c) -> a c +thenM = (>>=) + +thenM_ :: Monad a => a b -> a c -> a c +thenM_ = (>>) + +returnM :: Monad m => a -> m a +returnM = return + +mappM :: (Monad m) => (a -> m b) -> [a] -> m [b] +mappM = mapM + +mappM_ :: (Monad m) => (a -> m b) -> [a] -> m () +mappM_ = mapM_ + +checkM :: Monad m => Bool -> m () -> m () +checkM = unless \end{code} %********************************************************* @@ -211,35 +215,6 @@ lookupTopBndrRn_maybe rdr_name Nothing -> returnM Nothing Just gre -> returnM (Just $ gre_name gre) } --- lookupLocatedSigOccRn is used for type signatures and pragmas --- Is this valid? --- module A --- import M( f ) --- f :: Int -> Int --- f x = x --- It's clear that the 'f' in the signature must refer to A.f --- The Haskell98 report does not stipulate this, but it will! --- So we must treat the 'f' in the signature in the same way --- as the binding occurrence of 'f', using lookupBndrRn --- --- However, consider this case: --- import M( f ) --- f :: Int -> Int --- g x = x --- We don't want to say 'f' is out of scope; instead, we want to --- return the imported 'f', so that later on the reanamer will --- correctly report "misplaced type sig". -lookupLocatedSigOccRn :: Located RdrName -> RnM (Located Name) -lookupLocatedSigOccRn = wrapLocM $ \ rdr_name -> do - { local_env <- getLocalRdrEnv - ; case lookupLocalRdrEnv local_env rdr_name of { - Just n -> return n ; - Nothing -> do - { mb_gre <- lookupGreLocalRn rdr_name - ; case mb_gre of - Just gre -> return (gre_name gre) - Nothing -> lookupGlobalOccRn rdr_name - }}} ----------------------------------------------- lookupInstDeclBndr :: Name -> Located RdrName -> RnM (Located Name) @@ -256,9 +231,9 @@ lookupInstDeclBndr :: Name -> Located RdrName -> RnM (Located Name) -- an instance decl lookupInstDeclBndr cls rdr = lookup_located_sub_bndr is_op doc rdr where - doc = ptext SLIT("method of class") <+> quotes (ppr cls) - is_op gre@(GRE {gre_par = ParentIs n}) = n == cls - is_op other = False + doc = ptext (sLit "method of class") <+> quotes (ppr cls) + is_op (GRE {gre_par = ParentIs n}) = n == cls + is_op _ = False ----------------------------------------------- lookupRecordBndr :: Maybe (Located Name) -> Located RdrName -> RnM (Located Name) @@ -278,7 +253,7 @@ lookupRecordBndr (Just (L _ data_con)) rdr_name ; lookup_located_sub_bndr is_field doc rdr_name }} where - doc = ptext SLIT("field of constructor") <+> quotes (ppr data_con) + doc = ptext (sLit "field of constructor") <+> quotes (ppr data_con) lookupConstructorFields :: Name -> RnM [Name] @@ -307,6 +282,7 @@ lookup_located_sub_bndr :: (GlobalRdrElt -> Bool) lookup_located_sub_bndr is_good doc rdr_name = wrapLocM (lookup_sub_bndr is_good doc) rdr_name +lookup_sub_bndr :: (GlobalRdrElt -> Bool) -> SDoc -> RdrName -> RnM Name lookup_sub_bndr is_good doc rdr_name | isUnqual rdr_name -- Find all the things the rdr-name maps to = do { -- and pick the one with the right parent name @@ -356,7 +332,7 @@ lookupFamInstDeclBndr mod lrdr_name@(L _ rdr_name) getLookupOccRn :: RnM (Name -> Maybe Name) getLookupOccRn = getLocalRdrEnv `thenM` \ local_env -> - return (lookupLocalRdrEnv local_env . mkRdrUnqual . nameOccName) + return (lookupLocalRdrOcc local_env . nameOccName) lookupLocatedOccRn :: Located RdrName -> RnM (Located Name) lookupLocatedOccRn = wrapLocM lookupOccRn @@ -425,7 +401,7 @@ unboundName rdr_name = do { addErr (unknownNameErr rdr_name) ; env <- getGlobalRdrEnv; ; traceRn (vcat [unknownNameErr rdr_name, - ptext SLIT("Global envt is:"), + ptext (sLit "Global envt is:"), nest 3 (pprGlobalRdrEnv env)]) ; returnM (mkUnboundName rdr_name) } @@ -504,7 +480,7 @@ lookupQualifiedName rdr_name | otherwise = pprPanic "RnEnv.lookupQualifiedName" (ppr rdr_name) where - doc = ptext SLIT("Need to find") <+> ppr rdr_name + doc = ptext (sLit "Need to find") <+> ppr rdr_name \end{code} %********************************************************* @@ -514,57 +490,36 @@ lookupQualifiedName rdr_name %********************************************************* \begin{code} -lookupLocalDataTcNames :: RdrName -> RnM [Name] --- GHC extension: look up both the tycon and data con --- for con-like things --- Complain if neither is in scope -lookupLocalDataTcNames rdr_name - | Just n <- isExact_maybe rdr_name - -- Special case for (:), which doesn't get into the GlobalRdrEnv - = return [n] -- For this we don't need to try the tycon too - | otherwise - = do { mb_gres <- mapM lookupGreLocalRn (dataTcOccs rdr_name) - ; case [gre_name gre | Just gre <- mb_gres] of - [] -> do { - -- run for error reporting - ; unboundName rdr_name - ; return [] } - names -> return names - } +-------------------------------- +type FastStringEnv a = UniqFM a -- Keyed by FastString + + +emptyFsEnv :: FastStringEnv a +lookupFsEnv :: FastStringEnv a -> FastString -> Maybe a +extendFsEnv :: FastStringEnv a -> FastString -> a -> FastStringEnv a + +emptyFsEnv = emptyUFM +lookupFsEnv = lookupUFM +extendFsEnv = addToUFM -------------------------------- -bindLocalFixities :: [FixitySig RdrName] -> (UniqFM (Located Fixity) -> RnM a) -> RnM a --- Used for nested fixity decls: --- bind the names that are in scope already; --- pass the rest to the continuation for later --- as a FastString->(Located Fixity) map --- --- No need to worry about type constructors here, --- Should check for duplicates? -bindLocalFixities fixes thing_inside - | null fixes = thing_inside emptyUFM - | otherwise = do ls <- mappM rn_sig fixes - let (now, later) = nowAndLater ls - extendFixityEnv now $ thing_inside later - where - rn_sig (FixitySig lv@(L loc v) fix) = do - vopt <- lookupBndrRn_maybe v - case vopt of - Just new_v -> returnM (Left (new_v, (FixItem (rdrNameOcc v) fix))) - Nothing -> returnM (Right (occNameFS $ rdrNameOcc v, (L loc fix))) - - nowAndLater (ls :: [Either (Name, FixItem) (FastString, Located Fixity)]) = - foldr (\ cur -> \ (now, later) -> - case cur of - Left (n, f) -> ((n, f) : now, later) - Right (fs, f) -> (now, addToUFM later fs f)) - ([], emptyUFM) ls +type MiniFixityEnv = FastStringEnv (Located Fixity) + -- Mini fixity env for the names we're about + -- to bind, in a single binding group + -- + -- It is keyed by the *FastString*, not the *OccName*, because + -- the single fixity decl infix 3 T + -- affects both the data constructor T and the type constrctor T + -- + -- We keep the location so that if we find + -- a duplicate, we can report it sensibly +-------------------------------- -- Used for nested fixity decls to bind names along with their fixities. -- the fixities are given as a UFM from an OccName's FastString to a fixity decl -- Also check for unused binders bindLocalNamesFV_WithFixities :: [Name] - -> UniqFM (Located Fixity) + -> MiniFixityEnv -> RnM (a, FreeVars) -> RnM (a, FreeVars) bindLocalNamesFV_WithFixities names fixities thing_inside = bindLocalNamesFV names $ @@ -575,7 +530,7 @@ bindLocalNamesFV_WithFixities names fixities thing_inside boundFixities = foldr (\ name -> \ acc -> -- check whether this name has a fixity decl - case lookupUFM fixities (occNameFS (nameOccName name)) of + case lookupFsEnv fixities (occNameFS (nameOccName name)) of Just (L _ fix) -> (name, FixItem (nameOccName name) fix) : acc Nothing -> acc) [] names -- bind the names; extend the fixity env; do the thing inside @@ -628,13 +583,31 @@ lookupFixityRn name returnM (mi_fix_fn iface (nameOccName name)) } where - doc = ptext SLIT("Checking fixity for") <+> ppr name + doc = ptext (sLit "Checking fixity for") <+> ppr name --------------- lookupTyFixityRn :: Located Name -> RnM Fixity -lookupTyFixityRn (L loc n) = lookupFixityRn n +lookupTyFixityRn (L _ n) = lookupFixityRn n --------------- +lookupLocalDataTcNames :: RdrName -> RnM [Name] +-- GHC extension: look up both the tycon and data con +-- for con-like things +-- Complain if neither is in scope +lookupLocalDataTcNames rdr_name + | Just n <- isExact_maybe rdr_name + -- Special case for (:), which doesn't get into the GlobalRdrEnv + = return [n] -- For this we don't need to try the tycon too + | otherwise + = do { mb_gres <- mapM lookupGreLocalRn (dataTcOccs rdr_name) + ; case [gre_name gre | Just gre <- mb_gres] of + [] -> do { + -- run for error reporting + ; unboundName rdr_name + ; return [] } + names -> return names + } + dataTcOccs :: RdrName -> [RdrName] -- If the input is a data constructor, return both it and a type -- constructor. This is useful when we aren't sure which we are @@ -744,22 +717,25 @@ newLocalsRn rdr_names_w_loc -- lookupRdrEnv doesn't even attempt to look up a qualified RdrName mkInternalName uniq (rdrNameOcc rdr_name) loc +--------------------- +checkDupAndShadowedRdrNames :: SDoc -> [Located RdrName] -> RnM () +checkDupAndShadowedRdrNames doc loc_rdr_names + = do { checkDupRdrNames doc loc_rdr_names + ; envs <- getRdrEnvs + ; checkShadowedNames doc envs + [(loc,rdrNameOcc rdr) | L loc rdr <- loc_rdr_names] } + +--------------------- bindLocatedLocalsRn :: SDoc -- Documentation string for error message - -> [Located RdrName] + -> [Located RdrName] -> ([Name] -> RnM a) -> RnM a bindLocatedLocalsRn doc_str rdr_names_w_loc enclosed_scope - = -- Check for duplicate names - checkDupNames doc_str rdr_names_w_loc `thenM_` - - -- Warn about shadowing - checkShadowing doc_str rdr_names_w_loc `thenM_` + = checkDupAndShadowedRdrNames doc_str rdr_names_w_loc `thenM_` -- Make fresh Names and extend the environment - newLocalsRn rdr_names_w_loc `thenM` \ names -> - getLocalRdrEnv `thenM` \ local_env -> - setLocalRdrEnv (extendLocalRdrEnv local_env names) - (enclosed_scope names) + newLocalsRn rdr_names_w_loc `thenM` \names -> + bindLocalNames names (enclosed_scope names) bindLocalNames :: [Name] -> RnM a -> RnM a bindLocalNames names enclosed_scope @@ -841,31 +817,41 @@ extendTyVarEnvFVRn :: [Name] -> RnM (a, FreeVars) -> RnM (a, FreeVars) extendTyVarEnvFVRn tyvars thing_inside = bindLocalNamesFV tyvars thing_inside ------------------------------------- +checkDupRdrNames :: SDoc + -> [Located RdrName] + -> RnM () +checkDupRdrNames doc_str rdr_names_w_loc + = -- Check for duplicated names in a binding group + mappM_ (dupNamesErr getLoc doc_str) dups + where + (_, dups) = removeDups (\n1 n2 -> unLoc n1 `compare` unLoc n2) rdr_names_w_loc + checkDupNames :: SDoc - -> [Located RdrName] + -> [Name] -> RnM () -checkDupNames doc_str rdr_names_w_loc +checkDupNames doc_str names = -- Check for duplicated names in a binding group - mappM_ (dupNamesErr doc_str) dups + mappM_ (dupNamesErr nameSrcSpan doc_str) dups where - (_, dups) = removeDups (\n1 n2 -> unLoc n1 `compare` unLoc n2) rdr_names_w_loc + (_, dups) = removeDups (\n1 n2 -> nameOccName n1 `compare` nameOccName n2) names ------------------------------------- -checkShadowing doc_str loc_rdr_names - = traceRn (text "shadow" <+> ppr loc_rdr_names) `thenM_` - getLocalRdrEnv `thenM` \ local_env -> - getGlobalRdrEnv `thenM` \ global_env -> - let - check_shadow (L loc rdr_name) - | Just n <- mb_local = complain [ptext SLIT("bound at") <+> ppr (nameSrcLoc n)] +checkShadowedNames :: SDoc -> (GlobalRdrEnv, LocalRdrEnv) -> [(SrcSpan,OccName)] -> RnM () +checkShadowedNames doc_str (global_env,local_env) loc_rdr_names + = ifOptM Opt_WarnNameShadowing $ + do { traceRn (text "shadow" <+> ppr loc_rdr_names) + ; mappM_ check_shadow loc_rdr_names } + where + check_shadow (loc, occ) + | Just n <- mb_local = complain [ptext (sLit "bound at") <+> ppr (nameSrcLoc n)] | not (null gres) = complain (map pprNameProvenance gres) | otherwise = return () where - complain pp_locs = addWarnAt loc (shadowedNameWarn doc_str rdr_name pp_locs) - mb_local = lookupLocalRdrEnv local_env rdr_name - gres = lookupGRE_RdrName rdr_name global_env - in - ifOptM Opt_WarnNameShadowing (mappM_ check_shadow loc_rdr_names) + complain pp_locs = addWarnAt loc (shadowedNameWarn doc_str occ pp_locs) + mb_local = lookupLocalRdrOcc local_env occ + gres = lookupGRE_RdrName (mkRdrUnqual occ) global_env + -- Make an Unqualified RdrName and look that up, so that + -- we don't find any GREs that are in scope qualified-only \end{code} @@ -877,6 +863,7 @@ checkShadowing doc_str loc_rdr_names \begin{code} -- A useful utility +mapFvRn :: (a -> RnM (b, FreeVars)) -> [a] -> RnM ([b], FreeVars) mapFvRn f xs = mappM f xs `thenM` \ stuff -> let (ys, fvs_s) = unzip stuff @@ -908,37 +895,33 @@ warnUnusedModules mods = ifOptM Opt_WarnUnusedImports (mappM_ bleat mods) where bleat (mod,loc) = addWarnAt loc (mk_warn mod) - mk_warn m = vcat [ptext SLIT("Module") <+> quotes (ppr m) + mk_warn m = vcat [ptext (sLit "Module") <+> quotes (ppr m) <+> text "is imported, but nothing from it is used,", - nest 2 (ptext SLIT("except perhaps instances visible in") + nest 2 (ptext (sLit "except perhaps instances visible in") <+> quotes (ppr m)), - ptext SLIT("To suppress this warning, use:") - <+> ptext SLIT("import") <+> ppr m <> parens empty ] + ptext (sLit "To suppress this warning, use:") + <+> ptext (sLit "import") <+> ppr m <> parens empty ] warnUnusedImports, warnUnusedTopBinds :: [GlobalRdrElt] -> RnM () warnUnusedImports gres = ifOptM Opt_WarnUnusedImports (warnUnusedGREs gres) warnUnusedTopBinds gres = ifOptM Opt_WarnUnusedBinds (warnUnusedGREs gres) -warnUnusedLocalBinds, warnUnusedMatches :: [Name] -> RnM (a, FreeVars) -> RnM (a, FreeVars) +warnUnusedLocalBinds, warnUnusedMatches :: [Name] -> FreeVars -> RnM () warnUnusedLocalBinds = check_unused Opt_WarnUnusedBinds warnUnusedMatches = check_unused Opt_WarnUnusedMatches -check_unused :: DynFlag -> [Name] -> RnM (a, FreeVars) -> RnM (a, FreeVars) -check_unused flag names thing_inside - = do { (res, res_fvs) <- thing_inside - - -- Warn about unused names - ; ifOptM flag (warnUnusedLocals (filterOut (`elemNameSet` res_fvs) names)) - - -- And return - ; return (res, res_fvs) } +check_unused :: DynFlag -> [Name] -> FreeVars -> RnM () +check_unused flag bound_names used_names + = ifOptM flag (warnUnusedLocals (filterOut (`elemNameSet` used_names) bound_names)) ------------------------- -- Helpers +warnUnusedGREs :: [GlobalRdrElt] -> RnM () warnUnusedGREs gres = warnUnusedBinds [(n,p) | GRE {gre_name = n, gre_prov = p} <- gres] +warnUnusedLocals :: [Name] -> RnM () warnUnusedLocals names = warnUnusedBinds [(n,LocalDef) | n<-names] @@ -955,7 +938,7 @@ warnUnusedBinds names = mappM_ warnUnusedName (filter reportable names) warnUnusedName :: (Name, Provenance) -> RnM () warnUnusedName (name, LocalDef) = addUnusedWarning name (srcLocSpan (nameSrcLoc name)) - (ptext SLIT("Defined but not used")) + (ptext (sLit "Defined but not used")) warnUnusedName (name, Imported is) = mapM_ warn is @@ -964,8 +947,9 @@ warnUnusedName (name, Imported is) where span = importSpecLoc spec pp_mod = quotes (ppr (importSpecModule spec)) - msg = ptext SLIT("Imported from") <+> pp_mod <+> ptext SLIT("but not used") + msg = ptext (sLit "Imported from") <+> pp_mod <+> ptext (sLit "but not used") +addUnusedWarning :: Name -> SrcSpan -> SDoc -> RnM () addUnusedWarning name span msg = addWarnAt span $ sep [msg <> colon, @@ -974,48 +958,58 @@ addUnusedWarning name span msg \end{code} \begin{code} +addNameClashErrRn :: RdrName -> [GlobalRdrElt] -> RnM () addNameClashErrRn rdr_name names - = addErr (vcat [ptext SLIT("Ambiguous occurrence") <+> quotes (ppr rdr_name), - ptext SLIT("It could refer to") <+> vcat (msg1 : msgs)]) + = addErr (vcat [ptext (sLit "Ambiguous occurrence") <+> quotes (ppr rdr_name), + ptext (sLit "It could refer to") <+> vcat (msg1 : msgs)]) where (np1:nps) = names - msg1 = ptext SLIT("either") <+> mk_ref np1 - msgs = [ptext SLIT(" or") <+> mk_ref np | np <- nps] + msg1 = ptext (sLit "either") <+> mk_ref np1 + msgs = [ptext (sLit " or") <+> mk_ref np | np <- nps] mk_ref gre = quotes (ppr (gre_name gre)) <> comma <+> pprNameProvenance gre -shadowedNameWarn doc rdr_name shadowed_locs - = sep [ptext SLIT("This binding for") <+> quotes (ppr rdr_name) - <+> ptext SLIT("shadows the existing binding") <> plural shadowed_locs, +shadowedNameWarn :: SDoc -> OccName -> [SDoc] -> SDoc +shadowedNameWarn doc occ shadowed_locs + = sep [ptext (sLit "This binding for") <+> quotes (ppr occ) + <+> ptext (sLit "shadows the existing binding") <> plural shadowed_locs, nest 2 (vcat shadowed_locs)] $$ doc +unknownNameErr :: RdrName -> SDoc unknownNameErr rdr_name - = sep [ptext SLIT("Not in scope:"), - nest 2 $ pprNonVarNameSpace (occNameSpace (rdrNameOcc rdr_name)) - <+> quotes (ppr rdr_name)] + = vcat [ hang (ptext (sLit "Not in scope:")) + 2 (pprNonVarNameSpace (occNameSpace (rdrNameOcc rdr_name)) + <+> quotes (ppr rdr_name)) + , extra ] + where + extra | rdr_name == forall_tv_RDR + = ptext (sLit "Perhaps you intended to use -XRankNTypes or similar flag") + | otherwise = empty +unknownSubordinateErr :: SDoc -> RdrName -> SDoc unknownSubordinateErr doc op -- Doc is "method of class" or -- "field of constructor" - = quotes (ppr op) <+> ptext SLIT("is not a (visible)") <+> doc + = quotes (ppr op) <+> ptext (sLit "is not a (visible)") <+> doc +badOrigBinding :: RdrName -> SDoc badOrigBinding name - = ptext SLIT("Illegal binding of built-in syntax:") <+> ppr (rdrNameOcc name) + = ptext (sLit "Illegal binding of built-in syntax:") <+> ppr (rdrNameOcc name) -- The rdrNameOcc is because we don't want to print Prelude.(,) -dupNamesErr :: SDoc -> [Located RdrName] -> RnM () -dupNamesErr descriptor located_names +dupNamesErr :: Outputable n => (n -> SrcSpan) -> SDoc -> [n] -> RnM () +dupNamesErr get_loc descriptor names = addErrAt big_loc $ - vcat [ptext SLIT("Conflicting definitions for") <+> quotes (ppr name1), + vcat [ptext (sLit "Conflicting definitions for") <+> quotes (ppr (head names)), locations, descriptor] where - L _ name1 = head located_names - locs = map getLoc located_names + locs = map get_loc names big_loc = foldr1 combineSrcSpans locs one_line = isOneLineSpan big_loc locations | one_line = empty - | otherwise = ptext SLIT("Bound at:") <+> + | otherwise = ptext (sLit "Bound at:") <+> vcat (map ppr (sortLe (<=) locs)) +badQualBndrErr :: RdrName -> SDoc badQualBndrErr rdr_name - = ptext SLIT("Qualified name in binding position:") <+> ppr rdr_name + = ptext (sLit "Qualified name in binding position:") <+> ppr rdr_name \end{code}