Commit 61bcd16d authored by simonpj@microsoft.com's avatar simonpj@microsoft.com
Browse files

Fix Trac #2723: keep track of record field names in the renamer

The idea here is that with -XNamedFieldPuns and -XRecordWildCards we don't
want to report shadowing errors for
	let fld = <blah> in C { .. }
But to suppress such shadowing errors, the renamer needs to know that
'fld' *is* a record selector.  Hence the new NameSet in 
TcRnFypes.RecFieldEnv
parent d7b36bbb
......@@ -367,6 +367,12 @@ data GlobalRdrElt
gre_prov :: Provenance -- ^ Why it's in scope
}
-- | The children of a Name are the things that are abbreviated by the ".."
-- notation in export lists. Specifically:
-- TyCon Children are * data constructors
-- * record field ids
-- Class Children are * class operations
-- Each child has the parent thing as its Parent
data Parent = NoParent | ParentIs Name
deriving (Eq)
......
......@@ -41,8 +41,9 @@ import HsSyn
import RdrHsSyn ( extractHsTyRdrTyVars )
import RdrName
import HscTypes ( availNames, ModIface(..), FixItem(..), lookupFixity)
import TcEnv ( tcLookupDataCon, isBrackStage )
import TcEnv ( tcLookupDataCon, tcLookupField, isBrackStage )
import TcRnMonad
import Id ( isRecordSelector )
import Name ( Name, nameIsLocalOrFrom, mkInternalName, isWiredInName,
nameSrcLoc, nameSrcSpan, nameOccName, nameModule, isExternalName )
import NameSet
......@@ -230,9 +231,16 @@ lookupInstDeclBndr cls rdr = lookup_located_sub_bndr is_op doc rdr
-----------------------------------------------
lookupRecordBndr :: Maybe (Located Name) -> Located RdrName -> RnM (Located Name)
-- Used for record construction and pattern matching
-- When the -fdisambiguate-record-fields flag is on, take account of the
-- 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 } }
-- 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.
lookupRecordBndr Nothing rdr_name
= lookupLocatedGlobalOccRn rdr_name
lookupRecordBndr (Just (L _ data_con)) rdr_name
......@@ -261,7 +269,7 @@ lookupConstructorFields :: Name -> RnM [Name]
lookupConstructorFields con_name
= do { this_mod <- getModule
; if nameIsLocalOrFrom this_mod con_name then
do { field_env <- getRecFieldEnv
do { RecFields field_env _ <- getRecFieldEnv
; return (lookupNameEnv field_env con_name `orElse` []) }
else
do { con <- tcLookupDataCon con_name
......@@ -913,14 +921,31 @@ checkShadowedNames doc_str (global_env,local_env) 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 ()
| otherwise = do { gres' <- filterM is_shadowed_gre gres
; complain (map pprNameProvenance gres') }
where
complain [] = return ()
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
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 <- getDOpts
; if (dopt Opt_RecordPuns dflags || dopt 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) }
\end{code}
......
......@@ -1047,14 +1047,16 @@ extendRecordFieldEnv decls
; return $ unLoc x'}
get (L _ (TyData { tcdCons = cons })) env = foldrM get_con env cons
get _ env = return env
get _ env = return env
get_con (L _ (ConDecl { con_name = con, con_details = RecCon flds })) env
get_con (L _ (ConDecl { con_name = con, con_details = RecCon flds }))
(RecFields env fld_set)
= do { con' <- lookup con
; flds' <- mappM lookup (map cd_fld_name flds)
; return $ extendNameEnv env con' flds' }
get_con _ env
= return env
; flds' <- mappM lookup (map cd_fld_name flds)
; let env' = extendNameEnv env con' flds'
fld_set' = addListToNameSet fld_set flds'
; return $ (RecFields env' fld_set') }
get_con _ env = return env
\end{code}
%*********************************************************
......
......@@ -140,7 +140,7 @@ Then the renamer (which does not keep track of what is a record selector
and what is not) will rename the definition thus
f_7 = e { f_7 = True }
Now the type checker will find f_7 in the *local* type environment, not
the global one. It's wrong, of course, but we want to report a tidy
the global (imported) one. It's wrong, of course, but we want to report a tidy
error, not in TcEnv.notFound. -}
tcLookupDataCon :: Name -> TcM DataCon
......
......@@ -85,7 +85,7 @@ initTc hsc_env hsc_src keep_rn_syntax mod do_this
tcg_src = hsc_src,
tcg_rdr_env = hsc_global_rdr_env hsc_env,
tcg_fix_env = emptyNameEnv,
tcg_field_env = emptyNameEnv,
tcg_field_env = RecFields emptyNameEnv emptyNameSet,
tcg_default = Nothing,
tcg_type_env = hsc_global_type_env hsc_env,
tcg_type_env_var = type_env_var,
......
......@@ -13,7 +13,7 @@ module TcRnTypes(
IfGblEnv(..), IfLclEnv(..),
-- Ranamer types
ErrCtxt, RecFieldEnv,
ErrCtxt, RecFieldEnv(..),
ImportAvails(..), emptyImportAvails, plusImportAvails,
WhereFrom(..), mkModDeps,
......@@ -225,11 +225,16 @@ data TcGblEnv
tcg_hpc :: AnyHpcUsage -- True if any part of the prog uses hpc instrumentation.
}
type RecFieldEnv = NameEnv [Name] -- Maps a constructor name *in this module*
-- to the fields for that constructor
data RecFieldEnv
= RecFields (NameEnv [Name]) -- Maps a constructor name *in this module*
-- to the fields for that constructor
NameSet -- Set of all fields declared *in this module*;
-- used to suppress name-shadowing complaints
-- when using record wild cards
-- E.g. let fld = e in C {..}
-- This is used when dealing with ".." notation in record
-- construction and pattern matching.
-- The FieldEnv deals *only* with constructors defined in *thie*
-- The FieldEnv deals *only* with constructors defined in *this*
-- module. For imported modules, we get the same info from the
-- TypeEnv
\end{code}
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment