summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGeoffrey Mainland <mainland@apeiron.net>2013-06-05 17:47:53 +0100
committerGeoffrey Mainland <mainland@apeiron.net>2013-06-05 17:47:53 +0100
commitfc60a548cc7430907630130467683462797f20ab (patch)
treea6cbdfc4cddafab75499905123bcedf6cbe0cfd4
parentbd321fc3b82db2e8b62e4961213a8c279292f76f (diff)
downloadhaskell-fc60a548cc7430907630130467683462797f20ab.tar.gz
Untabify
-rw-r--r--compiler/rename/RnEnv.lhs805
1 files changed, 399 insertions, 406 deletions
diff --git a/compiler/rename/RnEnv.lhs b/compiler/rename/RnEnv.lhs
index b4efdf0df8..c3fd407ff9 100644
--- a/compiler/rename/RnEnv.lhs
+++ b/compiler/rename/RnEnv.lhs
@@ -4,78 +4,71 @@
\section[RnEnv]{Environment manipulation for the renamer monad}
\begin{code}
-{-# OPTIONS -fno-warn-tabs #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and
--- detab the module (please do the detabbing in a separate patch). See
--- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
--- for details
-
-module RnEnv (
- newTopSrcBinder,
- lookupLocatedTopBndrRn, lookupTopBndrRn,
- lookupLocatedOccRn, lookupOccRn,
- lookupLocalOccRn_maybe,
- lookupTypeOccRn, lookupKindOccRn,
+module RnEnv (
+ newTopSrcBinder,
+ lookupLocatedTopBndrRn, lookupTopBndrRn,
+ lookupLocatedOccRn, lookupOccRn,
+ lookupLocalOccRn_maybe,
+ lookupTypeOccRn, lookupKindOccRn,
lookupGlobalOccRn, lookupGlobalOccRn_maybe,
- HsSigCtxt(..), lookupLocalTcNames, lookupSigOccRn,
+ HsSigCtxt(..), lookupLocalTcNames, lookupSigOccRn,
- lookupFixityRn, lookupTyFixityRn,
- lookupInstDeclBndr, lookupSubBndrOcc, lookupFamInstName,
+ lookupFixityRn, lookupTyFixityRn,
+ lookupInstDeclBndr, lookupSubBndrOcc, lookupFamInstName,
greRdrName,
lookupSubBndrGREs, lookupConstructorFields,
- lookupSyntaxName, lookupSyntaxTable, lookupIfThenElse,
- lookupGreRn, lookupGreLocalRn, lookupGreRn_maybe,
- getLookupOccRn, addUsedRdrNames,
-
- newLocalBndrRn, newLocalBndrsRn,
- bindLocalName, bindLocalNames, bindLocalNamesFV,
- MiniFixityEnv, emptyFsEnv, extendFsEnv, lookupFsEnv,
- addLocalFixities,
- bindLocatedLocalsFV, bindLocatedLocalsRn,
- extendTyVarEnvFVRn,
-
- checkDupRdrNames, checkShadowedRdrNames,
+ lookupSyntaxName, lookupSyntaxTable, lookupIfThenElse,
+ lookupGreRn, lookupGreLocalRn, lookupGreRn_maybe,
+ getLookupOccRn, addUsedRdrNames,
+
+ newLocalBndrRn, newLocalBndrsRn,
+ bindLocalName, bindLocalNames, bindLocalNamesFV,
+ MiniFixityEnv, emptyFsEnv, extendFsEnv, lookupFsEnv,
+ addLocalFixities,
+ bindLocatedLocalsFV, bindLocatedLocalsRn,
+ extendTyVarEnvFVRn,
+
+ checkDupRdrNames, checkShadowedRdrNames,
checkDupNames, checkDupAndShadowedNames, checkTupSize,
- addFvRn, mapFvRn, mapMaybeFvRn, mapFvRnCPS,
- warnUnusedMatches,
- warnUnusedTopBinds, warnUnusedLocalBinds,
+ addFvRn, mapFvRn, mapMaybeFvRn, mapFvRnCPS,
+ warnUnusedMatches,
+ warnUnusedTopBinds, warnUnusedLocalBinds,
dataTcOccs, unknownNameErr, kindSigErr, perhapsForallMsg,
HsDocContext(..), docOfHsDocContext
) where
#include "HsVersions.h"
-import LoadIface ( loadInterfaceForName, loadSrcInterface )
+import LoadIface ( loadInterfaceForName, loadSrcInterface )
import IfaceEnv
import HsSyn
import RdrName
import HscTypes
-import TcEnv ( tcLookupDataCon, tcLookupField, isBrackStage )
+import TcEnv ( tcLookupDataCon, tcLookupField, isBrackStage )
import TcRnMonad
-import Id ( isRecordSelector )
+import Id ( isRecordSelector )
import Name
import NameSet
import NameEnv
import Avail
import Module ( ModuleName, moduleName )
import UniqFM
-import DataCon ( dataConFieldLabels, dataConTyCon )
-import TyCon ( isTupleTyCon, tyConArity )
+import DataCon ( dataConFieldLabels, dataConTyCon )
+import TyCon ( isTupleTyCon, tyConArity )
import PrelNames ( mkUnboundName, rOOT_MAIN, forall_tv_RDR )
-import ErrUtils ( MsgDoc )
+import ErrUtils ( MsgDoc )
import SrcLoc
import Outputable
import Util
import Maybes
-import ListSetOps ( removeDups )
+import ListSetOps ( removeDups )
import DynFlags
import FastString
import Control.Monad
import Data.List
import qualified Data.Set as Set
-import Constants ( mAX_TUPLE_SIZE )
+import Constants ( mAX_TUPLE_SIZE )
\end{code}
\begin{code}
@@ -85,32 +78,32 @@ thenM = (>>=)
\end{code}
%*********************************************************
-%* *
- Source-code binders
-%* *
+%* *
+ Source-code binders
+%* *
%*********************************************************
\begin{code}
newTopSrcBinder :: Located RdrName -> RnM Name
newTopSrcBinder (L loc rdr_name)
| Just name <- isExact_maybe rdr_name
- = -- This is here to catch
- -- (a) Exact-name binders created by Template Haskell
- -- (b) The PrelBase defn of (say) [] and similar, for which
- -- the parser reads the special syntax and returns an Exact RdrName
- -- We are at a binding site for the name, so check first that it
- -- the current module is the correct one; otherwise GHC can get
- -- very confused indeed. This test rejects code like
- -- data T = (,) Int Int
- -- unless we are in GHC.Tup
+ = -- This is here to catch
+ -- (a) Exact-name binders created by Template Haskell
+ -- (b) The PrelBase defn of (say) [] and similar, for which
+ -- the parser reads the special syntax and returns an Exact RdrName
+ -- We are at a binding site for the name, so check first that it
+ -- the current module is the correct one; otherwise GHC can get
+ -- very confused indeed. This test rejects code like
+ -- data T = (,) Int Int
+ -- unless we are in GHC.Tup
if isExternalName name then
do { this_mod <- getModule
; unless (this_mod == nameModule name)
- (addErrAt loc (badOrigBinding rdr_name))
+ (addErrAt loc (badOrigBinding rdr_name))
; return name }
else -- See Note [Binders in Template Haskell] in Convert.hs
do { let occ = nameOccName name
- ; occ `seq` return () -- c.f. seq in newGlobalBinder
+ ; occ `seq` return () -- c.f. seq in newGlobalBinder
; this_mod <- getModule
; updNameCache $ \ ns ->
let name' = mkExternalName (nameUnique name) this_mod occ loc
@@ -118,51 +111,51 @@ newTopSrcBinder (L loc rdr_name)
in (ns', name') }
| Just (rdr_mod, rdr_occ) <- isOrig_maybe rdr_name
- = do { this_mod <- getModule
+ = do { this_mod <- getModule
; unless (rdr_mod == this_mod || rdr_mod == rOOT_MAIN)
- (addErrAt loc (badOrigBinding rdr_name))
- -- When reading External Core we get Orig names as binders,
- -- but they should agree with the module gotten from the monad
- --
- -- We can get built-in syntax showing up here too, sadly. If you type
- -- data T = (,,,)
- -- the constructor is parsed as a type, and then RdrHsSyn.tyConToDataCon
- -- uses setRdrNameSpace to make it into a data constructors. At that point
- -- the nice Exact name for the TyCon gets swizzled to an Orig name.
- -- Hence the badOrigBinding error message.
- --
- -- Except for the ":Main.main = ..." definition inserted into
- -- the Main module; ugh!
-
- -- Because of this latter case, we call newGlobalBinder with a module from
- -- the RdrName, not from the environment. In principle, it'd be fine to
- -- have an arbitrary mixture of external core definitions in a single module,
- -- (apart from module-initialisation issues, perhaps).
- ; newGlobalBinder rdr_mod rdr_occ loc }
- --TODO, should pass the whole span
+ (addErrAt loc (badOrigBinding rdr_name))
+ -- When reading External Core we get Orig names as binders,
+ -- but they should agree with the module gotten from the monad
+ --
+ -- We can get built-in syntax showing up here too, sadly. If you type
+ -- data T = (,,,)
+ -- the constructor is parsed as a type, and then RdrHsSyn.tyConToDataCon
+ -- uses setRdrNameSpace to make it into a data constructors. At that point
+ -- the nice Exact name for the TyCon gets swizzled to an Orig name.
+ -- Hence the badOrigBinding error message.
+ --
+ -- Except for the ":Main.main = ..." definition inserted into
+ -- the Main module; ugh!
+
+ -- Because of this latter case, we call newGlobalBinder with a module from
+ -- the RdrName, not from the environment. In principle, it'd be fine to
+ -- have an arbitrary mixture of external core definitions in a single module,
+ -- (apart from module-initialisation issues, perhaps).
+ ; newGlobalBinder rdr_mod rdr_occ loc }
+ --TODO, should pass the whole span
| otherwise
- = do { unless (not (isQual rdr_name))
- (addErrAt loc (badQualBndrErr rdr_name))
- -- Binders should not be qualified; if they are, and with a different
- -- module name, we we get a confusing "M.T is not in scope" error later
-
- ; stage <- getStage
- ; if isBrackStage stage then
- -- We are inside a TH bracket, so make an *Internal* name
- -- See Note [Top-level Names in Template Haskell decl quotes] in RnNames
- do { uniq <- newUnique
- ; return (mkInternalName uniq (rdrNameOcc rdr_name) loc) }
- else
- -- Normal case
+ = do { unless (not (isQual rdr_name))
+ (addErrAt loc (badQualBndrErr rdr_name))
+ -- Binders should not be qualified; if they are, and with a different
+ -- module name, we we get a confusing "M.T is not in scope" error later
+
+ ; stage <- getStage
+ ; if isBrackStage stage then
+ -- We are inside a TH bracket, so make an *Internal* name
+ -- See Note [Top-level Names in Template Haskell decl quotes] in RnNames
+ do { uniq <- newUnique
+ ; return (mkInternalName uniq (rdrNameOcc rdr_name) loc) }
+ else
+ -- Normal case
do { this_mod <- getModule
; newGlobalBinder this_mod (rdrNameOcc rdr_name) loc } }
\end{code}
%*********************************************************
-%* *
- Source code occurrences
-%* *
+%* *
+ Source code occurrences
+%* *
%*********************************************************
Looking up a name in the RnEnv.
@@ -182,7 +175,7 @@ terribly efficient, but there seems to be no better way.
\begin{code}
lookupTopBndrRn :: RdrName -> RnM Name
lookupTopBndrRn n = do nopt <- lookupTopBndrRn_maybe n
- case nopt of
+ case nopt of
Just n' -> return n'
Nothing -> do traceRn $ text "lookupTopBndrRn"
unboundName WL_LocalTop n
@@ -194,9 +187,9 @@ lookupTopBndrRn_maybe :: RdrName -> RnM (Maybe Name)
-- Look up a top-level source-code binder. We may be looking up an unqualified 'f',
-- and there may be several imported 'f's too, which must not confuse us.
-- For example, this is OK:
--- import Foo( f )
--- infix 9 f -- The 'f' here does not need to be qualified
--- f x = x -- Nor here, of course
+-- import Foo( f )
+-- infix 9 f -- The 'f' here does not need to be qualified
+-- f x = x -- Nor here, of course
-- So we have to filter out the non-local ones.
--
-- A separate function (importsFromLocalDecls) reports duplicate top level
@@ -204,34 +197,34 @@ lookupTopBndrRn_maybe :: RdrName -> RnM (Maybe Name)
--
-- There should never be a qualified name in a binding position in Haskell,
-- but there can be if we have read in an external-Core file.
--- The Haskell parser checks for the illegal qualified name in Haskell
+-- The Haskell parser checks for the illegal qualified name in Haskell
-- source files, so we don't need to do so here.
lookupTopBndrRn_maybe rdr_name
| Just name <- isExact_maybe rdr_name
= do { name' <- lookupExactOcc name; return (Just name') }
- | Just (rdr_mod, rdr_occ) <- isOrig_maybe rdr_name
- -- This deals with the case of derived bindings, where
- -- we don't bother to call newTopSrcBinder first
- -- We assume there is no "parent" name
- = do { loc <- getSrcSpanM
- ; n <- newGlobalBinder rdr_mod rdr_occ loc
+ | Just (rdr_mod, rdr_occ) <- isOrig_maybe rdr_name
+ -- This deals with the case of derived bindings, where
+ -- we don't bother to call newTopSrcBinder first
+ -- We assume there is no "parent" name
+ = do { loc <- getSrcSpanM
+ ; n <- newGlobalBinder rdr_mod rdr_occ loc
; return (Just n)}
| otherwise
- = do { -- Check for operators in type or class declarations
+ = do { -- Check for operators in type or class declarations
-- See Note [Type and class operator definitions]
let occ = rdrNameOcc rdr_name
; when (isTcOcc occ && isSymOcc occ)
(do { op_ok <- xoptM Opt_TypeOperators
- ; unless op_ok (addErr (opDeclErr rdr_name)) })
+ ; unless op_ok (addErr (opDeclErr rdr_name)) })
+
+ ; mb_gre <- lookupGreLocalRn rdr_name
+ ; case mb_gre of
+ Nothing -> return Nothing
+ Just gre -> return (Just $ gre_name gre) }
- ; mb_gre <- lookupGreLocalRn rdr_name
- ; case mb_gre of
- Nothing -> return Nothing
- Just gre -> return (Just $ gre_name gre) }
-
-----------------------------------------------
lookupExactOcc :: Name -> RnM Name
@@ -246,26 +239,26 @@ lookupExactOcc name
= do { checkTupSize (tyConArity tycon)
; return name }
- | isExternalName name
+ | isExternalName name
= return name
- | otherwise
+ | otherwise
= do { env <- getGlobalRdrEnv
- ; let -- See Note [Splicing Exact names]
+ ; let -- See Note [Splicing Exact names]
main_occ = nameOccName name
demoted_occs = case demoteOccName main_occ of
Just occ -> [occ]
Nothing -> []
gres = [ gre | occ <- main_occ : demoted_occs
, gre <- lookupGlobalRdrEnv env occ
- , gre_name gre == name ]
+ , gre_name gre == name ]
; case gres of
[] -> -- See Note [Splicing Exact names]
do { lcl_env <- getLocalRdrEnv
; unless (name `inLocalRdrEnvScope` lcl_env)
(addErr exact_nm_err)
; return name }
-
+
[gre] -> return (gre_name gre)
_ -> pprPanic "lookupExactOcc" (ppr name $$ ppr gres) }
@@ -277,14 +270,14 @@ lookupExactOcc name
-----------------------------------------------
lookupInstDeclBndr :: Name -> SDoc -> RdrName -> RnM Name
--- This is called on the method name on the left-hand side of an
+-- This is called on the method name on the left-hand side of an
-- instance declaration binding. eg. instance Functor T where
-- fmap = ...
-- ^^^^ called on this
-- Regardless of how many unqualified fmaps are in scope, we want
-- the one that comes from the Functor class.
--
--- Furthermore, note that we take no account of whether the
+-- Furthermore, note that we take no account of whether the
-- name is only in scope qualified. I.e. even if method op is
-- in scope as M.op, we still allow plain 'op' on the LHS of
-- an instance decl
@@ -293,10 +286,10 @@ lookupInstDeclBndr :: Name -> SDoc -> RdrName -> RnM Name
-- depending on what we are looking up
lookupInstDeclBndr cls what rdr
= do { when (isQual rdr)
- (addErr (badQualBndrErr rdr))
- -- In an instance decl you aren't allowed
- -- to use a qualified name for the method
- -- (Although it'd make perfect sense.)
+ (addErr (badQualBndrErr rdr))
+ -- In an instance decl you aren't allowed
+ -- to use a qualified name for the method
+ -- (Although it'd make perfect sense.)
; lookupSubBndrOcc (ParentIs cls) doc rdr }
where
doc = what <+> ptext (sLit "of class") <+> quotes (ppr cls)
@@ -304,49 +297,49 @@ lookupInstDeclBndr cls what rdr
-----------------------------------------------
lookupFamInstName :: Maybe Name -> Located RdrName -> RnM (Located Name)
--- Used for TyData and TySynonym family instances only,
+-- Used for TyData and TySynonym family instances only,
-- See Note [Family instance binders]
lookupFamInstName (Just cls) tc_rdr -- Associated type; c.f RnBinds.rnMethodBind
= wrapLocM (lookupInstDeclBndr cls (ptext (sLit "associated type"))) tc_rdr
lookupFamInstName Nothing tc_rdr -- Family instance; tc_rdr is an *occurrence*
- = lookupLocatedOccRn tc_rdr
+ = lookupLocatedOccRn tc_rdr
-----------------------------------------------
lookupConstructorFields :: Name -> RnM [Name]
-- Look up the fields of a given constructor
--- * For constructors from this module, use the record field env,
--- which is itself gathered from the (as yet un-typechecked)
--- data type decls
---
--- * For constructors from imported modules, use the *type* environment
--- since imported modles are already compiled, the info is conveniently
--- right there
+-- * For constructors from this module, use the record field env,
+-- which is itself gathered from the (as yet un-typechecked)
+-- data type decls
+--
+-- * For constructors from imported modules, use the *type* environment
+-- since imported modles are already compiled, the info is conveniently
+-- right there
lookupConstructorFields con_name
- = do { this_mod <- getModule
- ; if nameIsLocalOrFrom this_mod con_name then
- do { RecFields field_env _ <- getRecFieldEnv
- ; return (lookupNameEnv field_env con_name `orElse` []) }
- else
- do { con <- tcLookupDataCon con_name
- ; return (dataConFieldLabels con) } }
+ = do { this_mod <- getModule
+ ; if nameIsLocalOrFrom this_mod con_name then
+ do { RecFields field_env _ <- getRecFieldEnv
+ ; return (lookupNameEnv field_env con_name `orElse` []) }
+ else
+ do { con <- tcLookupDataCon con_name
+ ; return (dataConFieldLabels con) } }
-----------------------------------------------
-- Used for record construction and pattern matching
-- When the -XDisambiguateRecordFields flag is on, take account of the
-- constructor name to disambiguate which field to use; it's just the
-- same as for instance decls
---
+--
-- NB: Consider this:
--- module Foo where { data R = R { fld :: Int } }
--- module Odd where { import Foo; fld x = x { fld = 3 } }
+-- module Foo where { data R = R { fld :: Int } }
+-- module Odd where { import Foo; fld x = x { fld = 3 } }
-- Arguably this should work, because the reference to 'fld' is
-- unambiguous because there is only one field id 'fld' in scope.
-- But currently it's rejected.
lookupSubBndrOcc :: Parent -- NoParent => just look it up as usual
- -- ParentIs p => use p to disambiguate
- -> SDoc -> RdrName
+ -- ParentIs p => use p to disambiguate
+ -> SDoc -> RdrName
-> RnM Name
lookupSubBndrOcc parent doc rdr_name
| Just n <- isExact_maybe rdr_name -- This happens in derived code
@@ -355,20 +348,20 @@ lookupSubBndrOcc parent doc rdr_name
| Just (rdr_mod, rdr_occ) <- isOrig_maybe rdr_name
= lookupOrig rdr_mod rdr_occ
- | otherwise -- Find all the things the rdr-name maps to
- = do { -- and pick the one with the right parent namep
- env <- getGlobalRdrEnv
- ; case lookupSubBndrGREs env parent rdr_name of
- -- NB: lookupGlobalRdrEnv, not lookupGRE_RdrName!
- -- The latter does pickGREs, but we want to allow 'x'
- -- even if only 'M.x' is in scope
- [gre] -> do { addUsedRdrName gre (used_rdr_name gre)
+ | otherwise -- Find all the things the rdr-name maps to
+ = do { -- and pick the one with the right parent namep
+ env <- getGlobalRdrEnv
+ ; case lookupSubBndrGREs env parent rdr_name of
+ -- NB: lookupGlobalRdrEnv, not lookupGRE_RdrName!
+ -- The latter does pickGREs, but we want to allow 'x'
+ -- even if only 'M.x' is in scope
+ [gre] -> do { addUsedRdrName gre (used_rdr_name gre)
-- Add a usage; this is an *occurrence* site
; return (gre_name gre) }
- [] -> do { addErr (unknownSubordinateErr doc rdr_name)
- ; return (mkUnboundName rdr_name) }
- gres -> do { addNameClashErrRn rdr_name gres
- ; return (gre_name (head gres)) } }
+ [] -> do { addErr (unknownSubordinateErr doc rdr_name)
+ ; return (mkUnboundName rdr_name) }
+ gres -> do { addNameClashErrRn rdr_name gres
+ ; return (gre_name (head gres)) } }
where
-- Note [Usage for sub-bndrs]
used_rdr_name gre
@@ -381,16 +374,16 @@ greRdrName gre
LocalDef -> unqual_rdr
Imported is -> used_rdr_name_from_is is
- where
+ where
occ = nameOccName (gre_name gre)
unqual_rdr = mkRdrUnqual occ
- used_rdr_name_from_is imp_specs -- rdr_name is unqualified
- | not (all (is_qual . is_decl) imp_specs)
+ used_rdr_name_from_is imp_specs -- rdr_name is unqualified
+ | not (all (is_qual . is_decl) imp_specs)
= unqual_rdr -- An unqualified import is available
| otherwise
- = -- Only qualified imports available, so make up
- -- a suitable qualifed name from the first imp_spec
+ = -- Only qualified imports available, so make up
+ -- a suitable qualifed name from the first imp_spec
ASSERT( not (null imp_specs) )
mkRdrQual (is_as (is_decl (head imp_specs))) occ
@@ -403,7 +396,7 @@ lookupSubBndrGREs :: GlobalRdrEnv -> Parent -> RdrName -> [GlobalRdrElt]
lookupSubBndrGREs env parent rdr_name
= case parent of
NoParent -> pickGREs rdr_name gres
- ParentIs p
+ ParentIs p
| isUnqual rdr_name -> filter (parent_is p) gres
| otherwise -> filter (parent_is p) (pickGREs rdr_name gres)
@@ -475,7 +468,7 @@ So we do the following
* Exact names are also use for purely local binders generated
by TH, such as \x_33. x_33
Both binder and occurrence are Exact RdrNames. The occurrence
- gets looked up in the LocalRdrEnv by RnEnv.lookupOccRn, and
+ gets looked up in the LocalRdrEnv by RnEnv.lookupOccRn, and
misses, because lookupLocalRdrEnv always returns Nothing for
an Exact Name. Now we fall through to lookupExactOcc, which
will find the Name is not in the GlobalRdrEnv, so we just use
@@ -484,7 +477,7 @@ So we do the following
Note [Splicing Exact names]
~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider the splice $(do { x <- newName "x"; return (VarE x) })
-This will generate a (HsExpr RdrName) term that mentions the
+This will generate a (HsExpr RdrName) term that mentions the
Exact RdrName "x_56" (or whatever), but does not bind it. So
when looking such Exact names we want to check that it's in scope,
otherwise the type checker will get confused. To do this we need to
@@ -492,14 +485,14 @@ keep track of all the Names in scope, and the LocalRdrEnv does just that;
we consult it with RdrName.inLocalRdrEnvScope.
There is another wrinkle. With TH and -XDataKinds, consider
- $( [d| data Nat = Zero
+ $( [d| data Nat = Zero
data T = MkT (Proxy 'Zero) |] )
After splicing, but before renaming we get this:
data Nat_77{tc} = Zero_78{d}
data T_79{tc} = MkT_80{d} (Proxy 'Zero_78{tc}) |] )
THe occurrence of 'Zero in the data type for T has the right unique,
but it has a TcClsName name-space in its OccName. (This is set by
-the ctxt_ns argument of Convert.thRdrName.) When we check that is
+the ctxt_ns argument of Convert.thRdrName.) When we check that is
in scope in the GlobalRdrEnv, we need to look up the DataName namespace
too. (An alternative would be to make the GlobalRdrEnv also have
a Name -> GRE mapping.)
@@ -507,7 +500,7 @@ a Name -> GRE mapping.)
Note [Usage for sub-bndrs]
~~~~~~~~~~~~~~~~~~~~~~~~~~
If you have this
- import qualified M( C( f ) )
+ import qualified M( C( f ) )
instance M.C T where
f x = x
then is the qualified import M.f used? Obviously yes.
@@ -525,13 +518,13 @@ Here we want to record a use of 'f', not of 'M.f', otherwise
we'll miss the fact that the qualified import is redundant.
--------------------------------------------------
--- Occurrences
+-- Occurrences
--------------------------------------------------
\begin{code}
getLookupOccRn :: RnM (Name -> Maybe Name)
getLookupOccRn
- = getLocalRdrEnv `thenM` \ local_env ->
+ = getLocalRdrEnv `thenM` \ local_env ->
return (lookupLocalRdrOcc local_env . nameOccName)
lookupLocatedOccRn :: Located RdrName -> RnM (Located Name)
@@ -539,7 +532,7 @@ lookupLocatedOccRn = wrapLocM lookupOccRn
lookupLocalOccRn_maybe :: RdrName -> RnM (Maybe Name)
-- Just look in the local environment
-lookupLocalOccRn_maybe rdr_name
+lookupLocalOccRn_maybe rdr_name
= do { local_env <- getLocalRdrEnv
; return (lookupLocalRdrEnv local_env rdr_name) }
@@ -559,9 +552,9 @@ lookupKindOccRn rdr_name
-- lookupPromotedOccRn looks up an optionally promoted RdrName.
lookupTypeOccRn :: RdrName -> RnM Name
--- see Note [Demotion]
-lookupTypeOccRn rdr_name
- = do { mb_name <- lookupOccRn_maybe rdr_name
+-- see Note [Demotion]
+lookupTypeOccRn rdr_name
+ = do { mb_name <- lookupOccRn_maybe rdr_name
; case mb_name of {
Just name -> return name ;
Nothing -> lookup_demoted rdr_name } }
@@ -574,14 +567,14 @@ lookup_demoted rdr_name
; mb_demoted_name <- lookupOccRn_maybe demoted_rdr
; case mb_demoted_name of
Nothing -> unboundName WL_Any rdr_name
- Just demoted_name
+ Just demoted_name
| data_kinds -> return demoted_name
| otherwise -> unboundNameX WL_Any rdr_name suggest_dk }
-
+
| otherwise
- = unboundName WL_Any rdr_name
+ = unboundName WL_Any rdr_name
- where
+ where
suggest_dk = ptext (sLit "A data constructor of that name is in scope; did you mean -XDataKinds?")
\end{code}
@@ -633,7 +626,7 @@ lookupOccRn_maybe rdr_name
lookupGlobalOccRn :: RdrName -> RnM Name
--- lookupGlobalOccRn is like lookupOccRn, except that it looks in the global
+-- lookupGlobalOccRn is like lookupOccRn, except that it looks in the global
-- environment. Adds an error message if the RdrName is not in scope.
lookupGlobalOccRn rdr_name
= do { mb_name <- lookupGlobalOccRn_maybe rdr_name
@@ -654,59 +647,59 @@ lookupGlobalOccRn_maybe rdr_name
; return (Just n) }
| otherwise
- = do { mb_gre <- lookupGreRn_maybe rdr_name
- ; case mb_gre of
- Nothing -> return Nothing
- Just gre -> return (Just (gre_name gre)) }
+ = do { mb_gre <- lookupGreRn_maybe rdr_name
+ ; case mb_gre of
+ Nothing -> return Nothing
+ Just gre -> return (Just (gre_name gre)) }
--------------------------------------------------
--- Lookup in the Global RdrEnv of the module
+-- Lookup in the Global RdrEnv of the module
--------------------------------------------------
lookupGreRn_maybe :: RdrName -> RnM (Maybe GlobalRdrElt)
-- Just look up the RdrName in the GlobalRdrEnv
-lookupGreRn_maybe rdr_name
+lookupGreRn_maybe rdr_name
= lookupGreRn_help rdr_name (lookupGRE_RdrName rdr_name)
lookupGreRn :: RdrName -> RnM GlobalRdrElt
-- If not found, add error message, and return a fake GRE
-lookupGreRn rdr_name
- = do { mb_gre <- lookupGreRn_maybe rdr_name
- ; case mb_gre of {
- Just gre -> return gre ;
- Nothing -> do
- { traceRn (text "lookupGreRn" <+> ppr rdr_name)
+lookupGreRn rdr_name
+ = do { mb_gre <- lookupGreRn_maybe rdr_name
+ ; case mb_gre of {
+ Just gre -> return gre ;
+ Nothing -> do
+ { traceRn (text "lookupGreRn" <+> ppr rdr_name)
; name <- unboundName WL_Global rdr_name
- ; return (GRE { gre_name = name, gre_par = NoParent,
- gre_prov = LocalDef }) }}}
+ ; return (GRE { gre_name = name, gre_par = NoParent,
+ gre_prov = LocalDef }) }}}
lookupGreLocalRn :: RdrName -> RnM (Maybe GlobalRdrElt)
-- Similar, but restricted to locally-defined things
-lookupGreLocalRn rdr_name
+lookupGreLocalRn rdr_name
= lookupGreRn_help rdr_name lookup_fn
where
lookup_fn env = filter isLocalGRE (lookupGRE_RdrName rdr_name env)
-lookupGreRn_help :: RdrName -- Only used in error message
- -> (GlobalRdrEnv -> [GlobalRdrElt]) -- Lookup function
- -> RnM (Maybe GlobalRdrElt)
+lookupGreRn_help :: RdrName -- Only used in error message
+ -> (GlobalRdrEnv -> [GlobalRdrElt]) -- Lookup function
+ -> RnM (Maybe GlobalRdrElt)
-- Checks for exactly one match; reports deprecations
-- Returns Nothing, without error, if too few
-lookupGreRn_help rdr_name lookup
- = do { env <- getGlobalRdrEnv
- ; case lookup env of
- [] -> return Nothing
- [gre] -> do { addUsedRdrName gre rdr_name
+lookupGreRn_help rdr_name lookup
+ = do { env <- getGlobalRdrEnv
+ ; case lookup env of
+ [] -> return Nothing
+ [gre] -> do { addUsedRdrName gre rdr_name
; return (Just gre) }
- gres -> do { addNameClashErrRn rdr_name gres
- ; return (Just (head gres)) } }
+ gres -> do { addNameClashErrRn rdr_name gres
+ ; return (Just (head gres)) } }
\end{code}
%*********************************************************
-%* *
- Deprecations
-%* *
+%* *
+ Deprecations
+%* *
%*********************************************************
Note [Handling of deprecations]
@@ -732,9 +725,9 @@ addUsedRdrName gre rdr
| isLocalGRE gre = return () -- No call to warnIfDeprecated
-- See Note [Handling of deprecations]
| otherwise = do { env <- getGblEnv
- ; warnIfDeprecated gre
+ ; warnIfDeprecated gre
; updMutVar (tcg_used_rdrnames env)
- (\s -> Set.insert rdr s) }
+ (\s -> Set.insert rdr s) }
addUsedRdrNames :: [RdrName] -> RnM ()
-- Record used sub-binders
@@ -744,7 +737,7 @@ addUsedRdrNames :: [RdrName] -> RnM ()
addUsedRdrNames rdrs
= do { env <- getGblEnv
; updMutVar (tcg_used_rdrnames env)
- (\s -> foldr Set.insert s rdrs) }
+ (\s -> foldr Set.insert s rdrs) }
warnIfDeprecated :: GlobalRdrElt -> RnM ()
warnIfDeprecated gre@(GRE { gre_name = name, gre_prov = Imported (imp_spec : _) })
@@ -752,7 +745,7 @@ warnIfDeprecated gre@(GRE { gre_name = name, gre_prov = Imported (imp_spec : _)
; when (wopt Opt_WarnWarningsDeprecations dflags) $
do { iface <- loadInterfaceForName doc name
; case lookupImpDeprec iface gre of
- Just txt -> addWarn (mk_msg txt)
+ Just txt -> addWarn (mk_msg txt)
Nothing -> return () } }
where
mk_msg txt = sep [ sep [ ptext (sLit "In the use of")
@@ -775,7 +768,7 @@ lookupImpDeprec :: ModIface -> GlobalRdrElt -> Maybe WarningTxt
lookupImpDeprec iface gre
= mi_warn_fn iface (gre_name gre) `mplus` -- Bleat if the thing,
case gre_par gre of -- or its parent, is warn'd
- ParentIs p -> mi_warn_fn iface p
+ ParentIs p -> mi_warn_fn iface p
NoParent -> Nothing
\end{code}
@@ -800,9 +793,9 @@ this is, after all, wired-in stuff.
%*********************************************************
-%* *
- GHCi support
-%* *
+%* *
+ GHCi support
+%* *
%*********************************************************
\begin{code}
@@ -813,12 +806,12 @@ 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 ->
+ = loadSrcInterface doc mod False Nothing `thenM` \ iface ->
case [ name
- | avail <- mi_exports iface,
- name <- availNames avail,
- nameOccName name == occ ] of
+ | 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 }
@@ -834,18 +827,18 @@ Note [Looking up signature names]
lookupSigOccRn is used for type signatures and pragmas
Is this valid?
module A
- import M( f )
- f :: Int -> Int
- f x = x
+ 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
+ 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".
@@ -871,30 +864,30 @@ data HsSigCtxt = ... | TopSigCtxt NameSet Bool | ....
f :: a -> a
\begin{code}
-data HsSigCtxt
+data HsSigCtxt
= TopSigCtxt NameSet Bool -- At top level, binding these names
-- See Note [Signatures for top level things]
-- Bool <=> ok to give sig for
-- class method or record selctor
| LocalBindCtxt NameSet -- In a local binding, binding these names
- | ClsDeclCtxt Name -- Class decl for this class
- | InstDeclCtxt Name -- Intsance decl for this class
- | HsBootCtxt -- Top level of a hs-boot file
+ | ClsDeclCtxt Name -- Class decl for this class
+ | InstDeclCtxt Name -- Intsance decl for this class
+ | HsBootCtxt -- Top level of a hs-boot file
lookupSigOccRn :: HsSigCtxt
- -> Sig RdrName
- -> Located RdrName -> RnM (Located Name)
+ -> Sig RdrName
+ -> Located RdrName -> RnM (Located Name)
lookupSigOccRn ctxt sig
- = wrapLocM $ \ rdr_name ->
+ = wrapLocM $ \ rdr_name ->
do { mb_name <- lookupBindGroupOcc ctxt (hsSigDoc sig) rdr_name
; case mb_name of
- Left err -> do { addErr err; return (mkUnboundName rdr_name) }
- Right name -> return name }
+ Left err -> do { addErr err; return (mkUnboundName rdr_name) }
+ Right name -> return name }
lookupBindGroupOcc :: HsSigCtxt
- -> SDoc
- -> RdrName -> RnM (Either MsgDoc Name)
--- Looks up the RdrName, expecting it to resolve to one of the
+ -> SDoc
+ -> RdrName -> RnM (Either MsgDoc Name)
+-- Looks up the RdrName, expecting it to resolve to one of the
-- bound names passed in. If not, return an appropriate error message
--
-- See Note [Looking up signature names]
@@ -902,71 +895,71 @@ lookupBindGroupOcc ctxt what rdr_name
| Just n <- isExact_maybe rdr_name
= do { n' <- lookupExactOcc n
; return (Right n') } -- Maybe we should check the side conditions
- -- but it's a pain, and Exact things only show
- -- up when you know what you are doing
+ -- but it's a pain, and Exact things only show
+ -- up when you know what you are doing
| Just (rdr_mod, rdr_occ) <- isOrig_maybe rdr_name
= do { n' <- lookupOrig rdr_mod rdr_occ
; return (Right n') }
| otherwise
- = case ctxt of
+ = case ctxt of
HsBootCtxt -> lookup_top (const True) True
TopSigCtxt ns meth_ok -> lookup_top (`elemNameSet` ns) meth_ok
- LocalBindCtxt ns -> lookup_group ns
- ClsDeclCtxt cls -> lookup_cls_op cls
- InstDeclCtxt cls -> lookup_cls_op cls
+ LocalBindCtxt ns -> lookup_group ns
+ ClsDeclCtxt cls -> lookup_cls_op cls
+ InstDeclCtxt cls -> lookup_cls_op cls
where
lookup_cls_op cls
- = do { env <- getGlobalRdrEnv
+ = do { env <- getGlobalRdrEnv
; let gres = lookupSubBndrGREs env (ParentIs cls) rdr_name
; case gres of
[] -> return (Left (unknownSubordinateErr doc rdr_name))
(gre:_) -> return (Right (gre_name gre)) }
- -- If there is more than one local GRE for the
+ -- If there is more than one local GRE for the
-- same OccName 'f', that will be reported separately
-- as a duplicate top-level binding for 'f'
where
doc = ptext (sLit "method of class") <+> quotes (ppr cls)
lookup_top keep_me meth_ok
- = do { env <- getGlobalRdrEnv
+ = do { env <- getGlobalRdrEnv
; let all_gres = lookupGlobalRdrEnv env (rdrNameOcc rdr_name)
; case filter (keep_me . gre_name) all_gres of
[] | null all_gres -> bale_out_with empty
| otherwise -> bale_out_with local_msg
- (gre:_)
- | ParentIs {} <- gre_par gre
+ (gre:_)
+ | ParentIs {} <- gre_par gre
, not meth_ok
- -> bale_out_with sub_msg
- | otherwise
+ -> bale_out_with sub_msg
+ | otherwise
-> return (Right (gre_name gre)) }
lookup_group bound_names -- Look in the local envt (not top level)
= do { local_env <- getLocalRdrEnv
; case lookupLocalRdrEnv local_env rdr_name of
- Just n
+ Just n
| n `elemNameSet` bound_names -> return (Right n)
| otherwise -> bale_out_with local_msg
Nothing -> bale_out_with empty }
- bale_out_with msg
- = return (Left (sep [ ptext (sLit "The") <+> what
- <+> ptext (sLit "for") <+> quotes (ppr rdr_name)
- , nest 2 $ ptext (sLit "lacks an accompanying binding")]
- $$ nest 2 msg))
+ bale_out_with msg
+ = return (Left (sep [ ptext (sLit "The") <+> what
+ <+> ptext (sLit "for") <+> quotes (ppr rdr_name)
+ , nest 2 $ ptext (sLit "lacks an accompanying binding")]
+ $$ nest 2 msg))
local_msg = parens $ ptext (sLit "The") <+> what <+> ptext (sLit "must be given where")
- <+> quotes (ppr rdr_name) <+> ptext (sLit "is declared")
+ <+> quotes (ppr rdr_name) <+> ptext (sLit "is declared")
sub_msg = parens $ ptext (sLit "You cannot give a") <+> what
- <+> ptext (sLit "for a record selector or class method")
+ <+> ptext (sLit "for a record selector or class method")
---------------
lookupLocalTcNames :: HsSigCtxt -> SDoc -> RdrName -> RnM [Name]
-- GHC extension: look up both the tycon and data con or variable.
--- Used for top-level fixity signatures and deprecations.
+-- Used for top-level fixity signatures and deprecations.
-- Complain if neither is in scope.
-- See Note [Fixity signature lookup]
lookupLocalTcNames ctxt what rdr_name
@@ -981,9 +974,9 @@ dataTcOccs :: RdrName -> [RdrName]
-- Return both the given name and the same name promoted to the TcClsName
-- namespace. This is useful when we aren't sure which we are looking at.
dataTcOccs rdr_name
- | Just n <- isExact_maybe rdr_name
+ | Just n <- isExact_maybe rdr_name
, not (isBuiltInSyntax n) -- See Note [dataTcOccs and Exact Names]
- = [rdr_name]
+ = [rdr_name]
| isDataOcc occ || isVarOcc occ
= [rdr_name, rdr_name_tc]
| otherwise
@@ -1006,9 +999,9 @@ Note that setRdrNameSpace on an Exact name requires the Name to be External,
which it always is for built in syntax.
%*********************************************************
-%* *
- Fixities
-%* *
+%* *
+ Fixities
+%* *
%*********************************************************
Note [Fixity signature lookup]
@@ -1033,7 +1026,7 @@ deprecation declarations, and lookup of names in GHCi.
\begin{code}
--------------------------------
-type FastStringEnv a = UniqFM a -- Keyed by FastString
+type FastStringEnv a = UniqFM a -- Keyed by FastString
emptyFsEnv :: FastStringEnv a
@@ -1046,15 +1039,15 @@ extendFsEnv = addToUFM
--------------------------------
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
+ -- 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.
@@ -1064,7 +1057,7 @@ addLocalFixities :: MiniFixityEnv -> [Name] -> RnM a -> RnM a
addLocalFixities mini_fix_env names thing_inside
= extendFixityEnv (mapCatMaybes find_fixity names) thing_inside
where
- find_fixity name
+ find_fixity name
= case lookupFsEnv mini_fix_env (occNameFS occ) of
Just (L _ fix) -> Just (name, FixItem occ fix)
Nothing -> Nothing
@@ -1073,7 +1066,7 @@ addLocalFixities mini_fix_env names thing_inside
\end{code}
--------------------------------
-lookupFixity is a bit strange.
+lookupFixity is a bit strange.
* Nested local fixity decls are put in the local fixity env, which we
find with getFixtyEnv
@@ -1081,31 +1074,31 @@ lookupFixity is a bit strange.
* Imported fixities are found in the HIT or PIT
* Top-level fixity decls in this module may be for Names that are
- either Global (constructors, class operations)
- or Local/Exported (everything else)
+ either Global (constructors, class operations)
+ or Local/Exported (everything else)
(See notes with RnNames.getLocalDeclBinders for why we have this split.)
We put them all in the local fixity environment
\begin{code}
lookupFixityRn :: Name -> RnM Fixity
lookupFixityRn name
- = getModule `thenM` \ this_mod ->
+ = 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:" <+>
+ 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
+ else -- It's 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
-- have been loaded yet. Why not? Suppose you import module A,
-- which exports a function 'f', thus;
-- module CurrentModule where
- -- import A( f )
- -- module A( f ) where
- -- import B( f )
+ -- import A( f )
+ -- module A( f ) where
+ -- import B( f )
-- Then B isn't loaded right away (after all, it's possible that
-- nothing from B will be used). When we come across a use of
-- 'f', we need to know its fixity, and it's then, and only
@@ -1113,10 +1106,10 @@ 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:" <+>
+ 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))
+ return (mi_fix_fn iface (nameOccName name))
}
where
doc = ptext (sLit "Checking fixity for") <+> ppr name
@@ -1128,15 +1121,15 @@ lookupTyFixityRn (L _ n) = lookupFixityRn n
\end{code}
%************************************************************************
-%* *
- Rebindable names
- Dealing with rebindable syntax is driven by the
- Opt_RebindableSyntax dynamic flag.
+%* *
+ Rebindable names
+ Dealing with rebindable syntax is driven by the
+ Opt_RebindableSyntax dynamic flag.
- In "deriving" code we don't want to use rebindable syntax
- so we switch off the flag locally
+ In "deriving" code we don't want to use rebindable syntax
+ so we switch off the flag locally
-%* *
+%* *
%************************************************************************
Haskell 98 says that when you say "3" you get the "fromInteger" from the
@@ -1144,8 +1137,8 @@ Standard Prelude, regardless of what is in scope. However, to experiment
with having a language that is less coupled to the standard prelude, we're
trying a non-standard extension that instead gives you whatever "Prelude.fromInteger"
happens to be in scope. Then you can
- import Prelude ()
- import MyPrelude as Prelude
+ import Prelude ()
+ import MyPrelude as Prelude
to get the desired effect.
At the moment this just happens for
@@ -1154,7 +1147,7 @@ At the moment this just happens for
* minus (arising from n+k patterns)
* "do" notation
-We store the relevant Name in the HsSyn tree, in
+We store the relevant Name in the HsSyn tree, in
* HsIntegral/HsFractional/HsIsString
* NegApp
* NPlusKPat
@@ -1171,33 +1164,33 @@ lookupIfThenElse :: RnM (Maybe (SyntaxExpr Name), FreeVars)
-- Different to lookupSyntaxName because in the non-rebindable
-- case we desugar directly rather than calling an existing function
-- Hence the (Maybe (SyntaxExpr Name)) return type
-lookupIfThenElse
+lookupIfThenElse
= do { rebind <- xoptM Opt_RebindableSyntax
- ; if not rebind
+ ; if not rebind
then return (Nothing, emptyFVs)
else do { ite <- lookupOccRn (mkVarUnqual (fsLit "ifThenElse"))
; return (Just (HsVar ite), unitFV ite) } }
-lookupSyntaxName :: Name -- The standard name
- -> RnM (SyntaxExpr Name, FreeVars) -- Possibly a non-standard name
+lookupSyntaxName :: Name -- The standard name
+ -> RnM (SyntaxExpr Name, FreeVars) -- Possibly a non-standard name
lookupSyntaxName std_name
- = xoptM Opt_RebindableSyntax `thenM` \ rebindable_on ->
- if not rebindable_on then normal_case
+ = xoptM Opt_RebindableSyntax `thenM` \ rebindable_on ->
+ if not rebindable_on then normal_case
else
- -- Get the similarly named thing from the local environment
+ -- Get the similarly named thing from the local environment
lookupOccRn (mkRdrUnqual (nameOccName std_name)) `thenM` \ usr_name ->
return (HsVar usr_name, unitFV usr_name)
where
normal_case = return (HsVar std_name, emptyFVs)
-lookupSyntaxTable :: [Name] -- Standard names
- -> RnM (SyntaxTable Name, FreeVars) -- See comments with HsExpr.ReboundNames
+lookupSyntaxTable :: [Name] -- Standard names
+ -> RnM (SyntaxTable Name, FreeVars) -- See comments with HsExpr.ReboundNames
lookupSyntaxTable std_names
- = xoptM Opt_RebindableSyntax `thenM` \ rebindable_on ->
- if not rebindable_on then normal_case
+ = xoptM Opt_RebindableSyntax `thenM` \ rebindable_on ->
+ if not rebindable_on then normal_case
else
- -- Get the similarly named thing from the local environment
- mapM (lookupOccRn . mkRdrUnqual . nameOccName) std_names `thenM` \ usr_names ->
+ -- Get the similarly named thing from the local environment
+ mapM (lookupOccRn . mkRdrUnqual . nameOccName) std_names `thenM` \ usr_names ->
return (std_names `zip` map HsVar usr_names, mkFVs usr_names)
where
@@ -1206,9 +1199,9 @@ lookupSyntaxTable std_names
%*********************************************************
-%* *
+%* *
\subsection{Binding}
-%* *
+%* *
%*********************************************************
\begin{code}
@@ -1216,12 +1209,12 @@ newLocalBndrRn :: Located RdrName -> RnM Name
-- Used for non-top-level binders. These should
-- never be qualified.
newLocalBndrRn (L loc rdr_name)
- | Just name <- isExact_maybe rdr_name
- = return name -- This happens in code generated by Template Haskell
- -- See Note [Binders in Template Haskell] in Convert.lhs
+ | Just name <- isExact_maybe rdr_name
+ = return name -- This happens in code generated by Template Haskell
+ -- See Note [Binders in Template Haskell] in Convert.lhs
| otherwise
= do { unless (isUnqual rdr_name)
- (addErrAt loc (badQualBndrErr rdr_name))
+ (addErrAt loc (badQualBndrErr rdr_name))
; uniq <- newUnique
; return (mkInternalName uniq (rdrNameOcc rdr_name) loc) }
@@ -1230,13 +1223,13 @@ newLocalBndrsRn = mapM newLocalBndrRn
---------------------
bindLocatedLocalsRn :: [Located RdrName]
- -> ([Name] -> RnM a)
- -> RnM a
+ -> ([Name] -> RnM a)
+ -> RnM a
bindLocatedLocalsRn rdr_names_w_loc enclosed_scope
= do { checkDupRdrNames rdr_names_w_loc
; checkShadowedRdrNames rdr_names_w_loc
- -- Make fresh Names and extend the environment
+ -- Make fresh Names and extend the environment
; names <- newLocalBndrsRn rdr_names_w_loc
; bindLocalNames names (enclosed_scope names) }
@@ -1244,34 +1237,34 @@ bindLocalNames :: [Name] -> RnM a -> RnM a
bindLocalNames names enclosed_scope
= do { name_env <- getLocalRdrEnv
; setLocalRdrEnv (extendLocalRdrEnvList name_env names)
- enclosed_scope }
+ enclosed_scope }
bindLocalName :: Name -> RnM a -> RnM a
bindLocalName name enclosed_scope
= do { name_env <- getLocalRdrEnv
; setLocalRdrEnv (extendLocalRdrEnv name_env name)
- enclosed_scope }
+ enclosed_scope }
bindLocalNamesFV :: [Name] -> RnM (a, FreeVars) -> RnM (a, FreeVars)
bindLocalNamesFV names enclosed_scope
- = do { (result, fvs) <- bindLocalNames names enclosed_scope
- ; return (result, delFVs names fvs) }
+ = do { (result, fvs) <- bindLocalNames names enclosed_scope
+ ; return (result, delFVs names fvs) }
-------------------------------------
- -- binLocalsFVRn is the same as bindLocalsRn
- -- except that it deals with free vars
-bindLocatedLocalsFV :: [Located RdrName]
+ -- binLocalsFVRn is the same as bindLocalsRn
+ -- except that it deals with free vars
+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) ->
+ = bindLocatedLocalsRn rdr_names $ \ names ->
+ enclosed_scope names `thenM` \ (thing, fvs) ->
return (thing, delFVs names fvs)
-------------------------------------
extendTyVarEnvFVRn :: [Name] -> RnM (a, FreeVars) -> RnM (a, FreeVars)
- -- This function is used only in rnSourceDecl on InstDecl
+ -- This function is used only in rnSourceDecl on InstDecl
extendTyVarEnvFVRn tyvars thing_inside = bindLocalNamesFV tyvars thing_inside
-------------------------------------
@@ -1313,44 +1306,44 @@ checkDupAndShadowedNames envs names
-------------------------------------
checkShadowedOccs :: (GlobalRdrEnv, LocalRdrEnv) -> [(SrcSpan,OccName)] -> RnM ()
checkShadowedOccs (global_env,local_env) loc_occs
- = ifWOptM Opt_WarnNameShadowing $
- do { traceRn (text "shadow" <+> ppr loc_occs)
- ; mapM_ check_shadow loc_occs }
+ = ifWOptM Opt_WarnNameShadowing $
+ do { traceRn (text "shadow" <+> ppr loc_occs)
+ ; mapM_ check_shadow loc_occs }
where
check_shadow (loc, occ)
- | startsWithUnderscore occ = return () -- Do not report shadowing for "_x"
- -- See Trac #3262
- | Just n <- mb_local = complain [ptext (sLit "bound at") <+> ppr (nameSrcLoc n)]
- | otherwise = do { gres' <- filterM is_shadowed_gre gres
- ; complain (map pprNameProvenance gres') }
- where
- complain [] = return ()
- complain pp_locs = addWarnAt loc (shadowedNameWarn occ pp_locs)
- mb_local = lookupLocalRdrOcc local_env occ
+ | startsWithUnderscore occ = return () -- Do not report shadowing for "_x"
+ -- See Trac #3262
+ | Just n <- mb_local = complain [ptext (sLit "bound at") <+> ppr (nameSrcLoc n)]
+ | otherwise = do { gres' <- filterM is_shadowed_gre gres
+ ; complain (map pprNameProvenance gres') }
+ where
+ complain [] = return ()
+ complain pp_locs = addWarnAt loc (shadowedNameWarn 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
+ -- Make an Unqualified RdrName and look that up, so that
+ -- we don't find any GREs that are in scope qualified-only
- is_shadowed_gre :: GlobalRdrElt -> RnM Bool
- -- Returns False for record selectors that are shadowed, when
- -- punning or wild-cards are on (cf Trac #2723)
+ is_shadowed_gre :: GlobalRdrElt -> RnM Bool
+ -- Returns False for record selectors that are shadowed, when
+ -- punning or wild-cards are on (cf Trac #2723)
is_shadowed_gre gre@(GRE { gre_par = ParentIs _ })
- = do { dflags <- getDynFlags
- ; if (xopt Opt_RecordPuns dflags || xopt Opt_RecordWildCards dflags)
- then do { is_fld <- is_rec_fld gre; return (not is_fld) }
- else return True }
+ = do { dflags <- getDynFlags
+ ; if (xopt Opt_RecordPuns dflags || xopt Opt_RecordWildCards dflags)
+ then do { is_fld <- is_rec_fld gre; return (not is_fld) }
+ else return True }
is_shadowed_gre _other = return True
- is_rec_fld gre -- Return True for record selector ids
- | isLocalGRE gre = do { RecFields _ fld_set <- getRecFieldEnv
- ; return (gre_name gre `elemNameSet` fld_set) }
- | otherwise = do { sel_id <- tcLookupField (gre_name gre)
- ; return (isRecordSelector sel_id) }
+ is_rec_fld gre -- Return True for record selector ids
+ | isLocalGRE gre = do { RecFields _ fld_set <- getRecFieldEnv
+ ; return (gre_name gre `elemNameSet` fld_set) }
+ | otherwise = do { sel_id <- tcLookupField (gre_name gre)
+ ; return (isRecordSelector sel_id) }
\end{code}
%************************************************************************
-%* *
+%* *
What to do when a lookup fails
%* *
%************************************************************************
@@ -1377,12 +1370,12 @@ unboundNameX where_look rdr_name extra
unknownNameErr :: SDoc -> RdrName -> SDoc
unknownNameErr what rdr_name
- = vcat [ hang (ptext (sLit "Not in scope:"))
- 2 (what <+> quotes (ppr rdr_name))
- , extra ]
+ = vcat [ hang (ptext (sLit "Not in scope:"))
+ 2 (what <+> quotes (ppr rdr_name))
+ , extra ]
where
extra | rdr_name == forall_tv_RDR = perhapsForallMsg
- | otherwise = empty
+ | otherwise = empty
type HowInScope = Either SrcSpan ImpDeclSpec
-- Left loc => locally bound at loc
@@ -1434,9 +1427,9 @@ unknownNameSuggestErr where_look tried_rdr_name
| tried_is_qual = []
| not local_ok = []
| otherwise = [ (mkRdrUnqual occ, nameSrcSpan name)
- | name <- localRdrEnvElts env
- , let occ = nameOccName name
- , correct_name_space occ]
+ | name <- localRdrEnvElts env
+ , let occ = nameOccName name
+ , correct_name_space occ]
gre_ok :: GlobalRdrElt -> Bool
gre_ok = case where_look of
@@ -1449,7 +1442,7 @@ unknownNameSuggestErr where_look tried_rdr_name
| gre <- globalRdrEnvElts global_env
, gre_ok gre
, let name = gre_name gre
- occ = nameOccName name
+ occ = nameOccName name
, correct_name_space occ
, (mod, how) <- quals_in_scope name (gre_prov gre)
, let rdr_qual = mkRdrQual mod occ ]
@@ -1470,12 +1463,12 @@ unknownNameSuggestErr where_look tried_rdr_name
-- Note [Only-quals]
-- The second alternative returns those names with the same
-- OccName as the one we tried, but live in *qualified* imports
- -- e.g. if you have:
- --
- -- > import qualified Data.Map as Map
- -- > foo :: Map
- --
- -- then we suggest @Map.Map@.
+ -- e.g. if you have:
+ --
+ -- > import qualified Data.Map as Map
+ -- > foo :: Map
+ --
+ -- then we suggest @Map.Map@.
--------------------
unquals_in_scope :: Name -> Provenance -> [HowInScope]
@@ -1502,9 +1495,9 @@ unknownNameSuggestErr where_look tried_rdr_name
\end{code}
%************************************************************************
-%* *
+%* *
\subsection{Free variable manipulation}
-%* *
+%* *
%************************************************************************
\begin{code}
@@ -1523,22 +1516,22 @@ mapMaybeFvRn _ Nothing = return (Nothing, emptyFVs)
mapMaybeFvRn f (Just x) = do { (y, fvs) <- f x; return (Just y, fvs) }
-- because some of the rename functions are CPSed:
--- maps the function across the list from left to right;
+-- maps the function across the list from left to right;
-- collects all the free vars into one set
-mapFvRnCPS :: (a -> (b -> RnM c) -> RnM c)
+mapFvRnCPS :: (a -> (b -> RnM c) -> RnM c)
-> [a] -> ([b] -> RnM c) -> RnM c
mapFvRnCPS _ [] cont = cont []
-mapFvRnCPS f (x:xs) cont = f x $ \ x' ->
+mapFvRnCPS f (x:xs) cont = f x $ \ x' ->
mapFvRnCPS f xs $ \ xs' ->
cont (x':xs')
\end{code}
%************************************************************************
-%* *
+%* *
\subsection{Envt utility functions}
-%* *
+%* *
%************************************************************************
\begin{code}
@@ -1565,9 +1558,9 @@ check_unused flag bound_names used_names
= ifWOptM flag (warnUnusedLocals (filterOut (`elemNameSet` used_names) bound_names))
-------------------------
--- Helpers
+-- Helpers
warnUnusedGREs :: [GlobalRdrElt] -> RnM ()
-warnUnusedGREs gres
+warnUnusedGREs gres
= warnUnusedBinds [(n,p) | GRE {gre_name = n, gre_prov = p} <- gres]
warnUnusedLocals :: [Name] -> RnM ()
@@ -1576,34 +1569,34 @@ warnUnusedLocals names
warnUnusedBinds :: [(Name,Provenance)] -> RnM ()
warnUnusedBinds names = mapM_ warnUnusedName (filter reportable names)
- where reportable (name,_)
- | isWiredInName name = False -- Don't report unused wired-in names
- -- Otherwise we get a zillion warnings
- -- from Data.Tuple
- | otherwise = not (startsWithUnderscore (nameOccName name))
+ where reportable (name,_)
+ | isWiredInName name = False -- Don't report unused wired-in names
+ -- Otherwise we get a zillion warnings
+ -- from Data.Tuple
+ | otherwise = not (startsWithUnderscore (nameOccName name))
-------------------------
warnUnusedName :: (Name, Provenance) -> RnM ()
warnUnusedName (name, LocalDef)
= addUnusedWarning name (nameSrcSpan name)
- (ptext (sLit "Defined but not used"))
+ (ptext (sLit "Defined but not used"))
warnUnusedName (name, Imported is)
= mapM_ warn is
where
warn spec = addUnusedWarning name span msg
- where
- span = importSpecLoc spec
- pp_mod = quotes (ppr (importSpecModule spec))
- msg = ptext (sLit "Imported from") <+> pp_mod <+> ptext (sLit "but not used")
+ where
+ span = importSpecLoc spec
+ pp_mod = quotes (ppr (importSpecModule spec))
+ 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,
- nest 2 $ pprNonVarNameSpace (occNameSpace (nameOccName name))
- <+> quotes (ppr name)]
+ sep [msg <> colon,
+ nest 2 $ pprNonVarNameSpace (occNameSpace (nameOccName name))
+ <+> quotes (ppr name)]
\end{code}
\begin{code}
@@ -1613,7 +1606,7 @@ addNameClashErrRn rdr_name gres
= return () -- that already, and we don't want an error cascade
| otherwise
= addErr (vcat [ptext (sLit "Ambiguous occurrence") <+> quotes (ppr rdr_name),
- ptext (sLit "It could refer to") <+> vcat (msg1 : msgs)])
+ ptext (sLit "It could refer to") <+> vcat (msg1 : msgs)])
where
(np1:nps) = gres
msg1 = ptext (sLit "either") <+> mk_ref np1
@@ -1623,29 +1616,29 @@ addNameClashErrRn rdr_name gres
shadowedNameWarn :: OccName -> [SDoc] -> SDoc
shadowedNameWarn 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)]
+ <+> ptext (sLit "shadows the existing binding") <> plural shadowed_locs,
+ nest 2 (vcat shadowed_locs)]
perhapsForallMsg :: SDoc
-perhapsForallMsg
+perhapsForallMsg
= vcat [ ptext (sLit "Perhaps you intended to use -XExplicitForAll or similar flag")
- , ptext (sLit "to enable explicit-forall syntax: forall <tvs>. <type>")]
+ , ptext (sLit "to enable explicit-forall syntax: forall <tvs>. <type>")]
unknownSubordinateErr :: SDoc -> RdrName -> SDoc
-unknownSubordinateErr doc op -- Doc is "method of class" or
- -- "field of constructor"
+unknownSubordinateErr doc op -- Doc is "method of class" or
+ -- "field of constructor"
= 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)
- -- The rdrNameOcc is because we don't want to print Prelude.(,)
+ -- The rdrNameOcc is because we don't want to print Prelude.(,)
dupNamesErr :: Outputable n => (n -> SrcSpan) -> [n] -> RnM ()
dupNamesErr get_loc names
= addErrAt big_loc $
vcat [ptext (sLit "Conflicting definitions for") <+> quotes (ppr (head names)),
- locations]
+ locations]
where
locs = map get_loc names
big_loc = foldr1 combineSrcSpans locs
@@ -1661,25 +1654,25 @@ badQualBndrErr rdr_name
= ptext (sLit "Qualified name in binding position:") <+> ppr rdr_name
opDeclErr :: RdrName -> SDoc
-opDeclErr n
+opDeclErr n
= hang (ptext (sLit "Illegal declaration of a type or class operator") <+> quotes (ppr n))
2 (ptext (sLit "Use -XTypeOperators to declare operators in type and declarations"))
checkTupSize :: Int -> RnM ()
checkTupSize tup_size
- | tup_size <= mAX_TUPLE_SIZE
+ | tup_size <= mAX_TUPLE_SIZE
= return ()
- | otherwise
+ | otherwise
= addErr (sep [ptext (sLit "A") <+> int tup_size <> ptext (sLit "-tuple is too large for GHC"),
- nest 2 (parens (ptext (sLit "max size is") <+> int mAX_TUPLE_SIZE)),
- nest 2 (ptext (sLit "Workaround: use nested tuples or define a data type"))])
+ nest 2 (parens (ptext (sLit "max size is") <+> int mAX_TUPLE_SIZE)),
+ nest 2 (ptext (sLit "Workaround: use nested tuples or define a data type"))])
\end{code}
%************************************************************************
-%* *
+%* *
\subsection{Contexts for renaming errors}
-%* *
+%* *
%************************************************************************
\begin{code}
@@ -1719,7 +1712,7 @@ docOfHsDocContext (TyDataCtx tycon) = text "In the data type declaration for" <+
docOfHsDocContext (TySynCtx name) = text "In the declaration for type synonym" <+> quotes (ppr name)
docOfHsDocContext (TyFamilyCtx name) = text "In the declaration for type family" <+> quotes (ppr name)
docOfHsDocContext (ConDeclCtx name) = text "In the definition of data constructor" <+> quotes (ppr name)
-docOfHsDocContext (ClassDeclCtx name) = text "In the declaration for class" <+> ppr name
+docOfHsDocContext (ClassDeclCtx name) = text "In the declaration for class" <+> ppr name
docOfHsDocContext ExprWithTySigCtx = text "In an expression type signature"
docOfHsDocContext TypBrCtx = ptext (sLit "In a Template-Haskell quoted type")
docOfHsDocContext HsTypeCtx = text "In a type argument"