diff options
Diffstat (limited to 'compiler/rename/RnEnv.lhs')
| -rw-r--r-- | compiler/rename/RnEnv.lhs | 80 |
1 files changed, 45 insertions, 35 deletions
diff --git a/compiler/rename/RnEnv.lhs b/compiler/rename/RnEnv.lhs index 90061b10a2..d73b537af0 100644 --- a/compiler/rename/RnEnv.lhs +++ b/compiler/rename/RnEnv.lhs @@ -25,7 +25,7 @@ module RnEnv ( newLocalBndrRn, newLocalBndrsRn, bindLocalName, bindLocalNames, bindLocalNamesFV, - MiniFixityEnv, emptyFsEnv, extendFsEnv, lookupFsEnv, + MiniFixityEnv, addLocalFixities, bindLocatedLocalsFV, bindLocatedLocalsRn, extendTyVarEnvFVRn, @@ -36,7 +36,10 @@ module RnEnv ( warnUnusedMatches, warnUnusedTopBinds, warnUnusedLocalBinds, dataTcOccs, unknownNameErr, kindSigErr, perhapsForallMsg, - HsDocContext(..), docOfHsDocContext + HsDocContext(..), docOfHsDocContext, + + -- FsEnv + FastStringEnv, emptyFsEnv, lookupFsEnv, extendFsEnv, mkFsEnv ) where #include "HsVersions.h" @@ -57,8 +60,9 @@ import Module import UniqFM import DataCon ( dataConFieldLabels, dataConTyCon ) import TyCon ( isTupleTyCon, tyConArity ) -import PrelNames ( mkUnboundName, rOOT_MAIN, forall_tv_RDR ) +import PrelNames ( mkUnboundName, isUnboundName, rOOT_MAIN, forall_tv_RDR ) import ErrUtils ( MsgDoc ) +import BasicTypes ( Fixity(..), FixityDirection(..), minPrecedence ) import SrcLoc import Outputable import Util @@ -72,12 +76,6 @@ import qualified Data.Set as Set import Constants ( mAX_TUPLE_SIZE ) \end{code} -\begin{code} --- XXX -thenM :: Monad a => a b -> (b -> a c) -> a c -thenM = (>>=) -\end{code} - %********************************************************* %* * Source-code binders @@ -530,8 +528,8 @@ we'll miss the fact that the qualified import is redundant. \begin{code} getLookupOccRn :: RnM (Name -> Maybe Name) getLookupOccRn - = getLocalRdrEnv `thenM` \ local_env -> - return (lookupLocalRdrOcc local_env . nameOccName) + = do local_env <- getLocalRdrEnv + return (lookupLocalRdrOcc local_env . nameOccName) lookupLocatedOccRn :: Located RdrName -> RnM (Located Name) lookupLocatedOccRn = wrapLocM lookupOccRn @@ -814,15 +812,15 @@ lookupQualifiedName rdr_name | Just (mod,occ) <- isQual_maybe rdr_name -- Note: we want to behave as we would for a source file import here, -- and respect hiddenness of modules/packages, hence loadSrcInterface. - = loadSrcInterface doc mod False Nothing `thenM` \ iface -> + = do iface <- loadSrcInterface doc mod False Nothing - case [ name - | avail <- mi_exports iface, - name <- availNames avail, - nameOccName name == occ ] of - (n:ns) -> ASSERT (null ns) return (Just n) - _ -> do { traceRn (text "lookupQualified" <+> ppr rdr_name) - ; return Nothing } + case [ name + | avail <- mi_exports iface, + name <- availNames avail, + nameOccName name == occ ] of + (n:ns) -> ASSERT(null ns) return (Just n) + _ -> do { traceRn (text "lookupQualified" <+> ppr rdr_name) + ; return Nothing } | otherwise = pprPanic "RnEnv.lookupQualifiedName" (ppr rdr_name) @@ -1040,10 +1038,12 @@ type FastStringEnv a = UniqFM a -- Keyed by FastString emptyFsEnv :: FastStringEnv a lookupFsEnv :: FastStringEnv a -> FastString -> Maybe a extendFsEnv :: FastStringEnv a -> FastString -> a -> FastStringEnv a +mkFsEnv :: [(FastString,a)] -> FastStringEnv a emptyFsEnv = emptyUFM lookupFsEnv = lookupUFM extendFsEnv = addToUFM +mkFsEnv = listToUFM -------------------------------- type MiniFixityEnv = FastStringEnv (Located Fixity) @@ -1090,14 +1090,25 @@ lookupFixity is a bit strange. \begin{code} lookupFixityRn :: Name -> RnM Fixity lookupFixityRn name - = getModule `thenM` \ this_mod -> - if nameIsLocalOrFrom this_mod name - then do -- It's defined in this module - local_fix_env <- getFixityEnv - traceRn (text "lookupFixityRn: looking up name in local environment:" <+> - vcat [ppr name, ppr local_fix_env]) - return $ lookupFixity local_fix_env name - else -- It's imported + | isUnboundName name + = return (Fixity minPrecedence InfixL) + -- Minimise errors from ubound names; eg + -- a>0 `foo` b>0 + -- where 'foo' is not in scope, should not give an error (Trac #7937) + + | otherwise + = do { this_mod <- getModule + ; if nameIsLocalOrFrom this_mod name + then lookup_local + else lookup_imported } + where + lookup_local -- It's defined in this module + = do { local_fix_env <- getFixityEnv + ; traceRn (text "lookupFixityRn: looking up name in local environment:" <+> + vcat [ppr name, ppr local_fix_env]) + ; return (lookupFixity local_fix_env name) } + + lookup_imported -- For imported names, we have to get their fixities by doing a -- loadInterfaceForName, and consulting the Ifaces that comes back -- from that, because the interface file for the Name might not @@ -1114,12 +1125,11 @@ lookupFixityRn name -- -- loadInterfaceForName will find B.hi even if B is a hidden module, -- and that's what we want. - loadInterfaceForName doc name `thenM` \ iface -> do { - traceRn (text "lookupFixityRn: looking up name in iface cache and found:" <+> - vcat [ppr name, ppr $ mi_fix_fn iface (nameOccName name)]); - return (mi_fix_fn iface (nameOccName name)) - } - where + = do { iface <- loadInterfaceForName doc name + ; traceRn (text "lookupFixityRn: looking up name in iface cache and found:" <+> + vcat [ppr name, ppr $ mi_fix_fn iface (nameOccName name)]) + ; return (mi_fix_fn iface (nameOccName name)) } + doc = ptext (sLit "Checking fixity for") <+> ppr name --------------- @@ -1262,8 +1272,8 @@ bindLocatedLocalsFV :: [Located RdrName] -> ([Name] -> RnM (a,FreeVars)) -> RnM (a, FreeVars) bindLocatedLocalsFV rdr_names enclosed_scope = bindLocatedLocalsRn rdr_names $ \ names -> - enclosed_scope names `thenM` \ (thing, fvs) -> - return (thing, delFVs names fvs) + do (thing, fvs) <- enclosed_scope names + return (thing, delFVs names fvs) ------------------------------------- |