getLookupOccRn,
newLocalsRn, newIPNameRn,
- bindLocalNames, bindLocalNamesFV, bindLocalNamesFV_WithFixities,
+ bindLocalNames, bindLocalNamesFV,
+ MiniFixityEnv, bindLocalNamesFV_WithFixities,
bindLocatedLocalsFV, bindLocatedLocalsRn,
bindSigTyVarsFV, bindPatSigTyVars, bindPatSigTyVarsFV,
bindTyVarsRn, extendTyVarEnvFVRn,
mapFvRn, mapFvRnCPS,
warnUnusedMatches, warnUnusedModules, warnUnusedImports,
warnUnusedTopBinds, warnUnusedLocalBinds,
- dataTcOccs, unknownNameErr,
+ dataTcOccs, unknownNameErr
) where
#include "HsVersions.h"
nameSrcLoc, nameSrcSpan, nameOccName, nameModule, isExternalName )
import NameSet
import NameEnv
-import UniqFM
+import LazyUniqFM
import DataCon ( dataConFieldLabels )
-import OccName ( 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,
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}
%*********************************************************
}
--------------------------------
+type MiniFixityEnv = OccEnv (Located Fixity)
+ -- Mini fixity env for the names we're about
+ -- to bind, in a single binding group
+ --
+ -- We keep the location so that if we find
+ -- a duplicate, we can report it sensibly
+
bindLocalFixities :: [FixitySig RdrName] -> (UniqFM (Located Fixity) -> RnM a) -> RnM a
-- Used for nested fixity decls:
-- bind the names that are in scope already;
-- 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 $
boundFixities = foldr
(\ name -> \ acc ->
-- check whether this name has a fixity decl
- case lookupUFM fixities (occNameFS (nameOccName name)) of
+ case lookupOccEnv fixities (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
; mappM_ check_shadow loc_rdr_names }
where
check_shadow (loc, occ)
- | Just n <- mb_local = complain [ptext SLIT("bound at") <+> ppr loc]
+ | Just n <- mb_local = complain [ptext SLIT("bound at") <+> ppr (nameSrcLoc n)]
| not (null gres) = complain (map pprNameProvenance gres)
| otherwise = return ()
where
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
$$ doc
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 doc op -- Doc is "method of class" or
-- "field of constructor"