Commit 7100850e authored by Adam Gundry's avatar Adam Gundry Committed by Ben Gamari
Browse files

Use data con name instead of parent in lookupRecFieldOcc

Test Plan: new tests rename/should_compile/{T14747,T15149}

Reviewers: simonpj, bgamari

Reviewed By: bgamari

Subscribers: rwbarton, thomie, carter

GHC Trac Issues: #14747, #15149

Differential Revision: https://phabricator.haskell.org/D4821
parent 9c89ef39
......@@ -80,6 +80,7 @@ import RnUtils
import Data.Maybe (isJust)
import qualified Data.Semigroup as Semi
import Data.Either ( partitionEithers )
import Data.List (find)
{-
*********************************************************
......@@ -432,34 +433,122 @@ lookupExactOrOrig rdr_name res k
-----------------------------------------------
-- 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
-- | Look up an occurrence of a field in record construction or pattern
-- matching (but not update). When the -XDisambiguateRecordFields
-- flag is on, take account of the data constructor name to
-- disambiguate which field to use.
--
-- 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.
lookupRecFieldOcc :: Maybe Name -- Nothing => just look it up as usual
-- Just tycon => use tycon to disambiguate
-> SDoc -> RdrName
-- See Note [DisambiguateRecordFields].
lookupRecFieldOcc :: Maybe Name -- Nothing => just look it up as usual
-- Just con => use data con to disambiguate
-> RdrName
-> RnM Name
lookupRecFieldOcc parent doc rdr_name
| Just tc_name <- parent
= do { mb_name <- lookupSubBndrOcc True tc_name doc rdr_name
; case mb_name of
Left err -> do { addErr err; return (mkUnboundNameRdr rdr_name) }
Right n -> return n }
lookupRecFieldOcc mb_con rdr_name
| Just con <- mb_con
, isUnboundName con -- Avoid error cascade
= return (mkUnboundNameRdr rdr_name)
| Just con <- mb_con
= do { flds <- lookupConstructorFields con
; env <- getGlobalRdrEnv
; let lbl = occNameFS (rdrNameOcc rdr_name)
mb_field = do fl <- find ((== lbl) . flLabel) flds
-- We have the label, now check it is in
-- scope (with the correct qualifier if
-- there is one, hence calling pickGREs).
gre <- lookupGRE_FieldLabel env fl
guard (not (isQual rdr_name
&& null (pickGREs rdr_name [gre])))
return (fl, gre)
; case mb_field of
Just (fl, gre) -> do { addUsedGRE True gre
; return (flSelector fl) }
Nothing -> lookupGlobalOccRn rdr_name }
-- See Note [Fall back on lookupGlobalOccRn in lookupRecFieldOcc]
| otherwise
-- This use of Global is right as we are looking up a selector which
-- can only be defined at the top level.
= lookupGlobalOccRn rdr_name
{- Note [DisambiguateRecordFields]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
When we are looking up record fields in record construction or pattern
matching, we can take advantage of the data constructor name to
resolve fields that would otherwise be ambiguous (provided the
-XDisambiguateRecordFields flag is on).
For example, consider:
data S = MkS { x :: Int }
data T = MkT { x :: Int }
e = MkS { x = 3 }
When we are renaming the occurrence of `x` in `e`, instead of looking
`x` up directly (and finding both fields), lookupRecFieldOcc will
search the fields of `MkS` to find the only possible `x` the user can
mean.
Of course, we still have to check the field is in scope, using
lookupGRE_FieldLabel. The handling of qualified imports is slightly
subtle: the occurrence may be unqualified even if the field is
imported only qualified (but if the occurrence is qualified, the
qualifier must be correct). For example:
module A where
data S = MkS { x :: Int }
data T = MkT { x :: Int }
module B where
import qualified A (S(..))
import A (T(MkT))
e1 = MkT { x = 3 } -- x not in scope, so fail
e2 = A.MkS { B.x = 3 } -- module qualifier is wrong, so fail
e3 = A.MkS { x = 3 } -- x in scope (lack of module qualifier permitted)
In case `e1`, lookupGRE_FieldLabel will return Nothing. In case `e2`,
lookupGRE_FieldLabel will return the GRE for `A.x`, but then the guard
will fail because the field RdrName `B.x` is qualified and pickGREs
rejects the GRE. In case `e3`, lookupGRE_FieldLabel will return the
GRE for `A.x` and the guard will succeed because the field RdrName `x`
is unqualified.
Note [Fall back on lookupGlobalOccRn in lookupRecFieldOcc]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Whenever we fail to find the field or it is not in scope, mb_field
will be False, and we fall back on looking it up normally using
lookupGlobalOccRn. We don't report an error immediately because the
actual problem might be located elsewhere. For example (Trac #9975):
data Test = Test { x :: Int }
pattern Test wat = Test { x = wat }
Here there are multiple declarations of Test (as a data constructor
and as a pattern synonym), which will be reported as an error. We
shouldn't also report an error about the occurrence of `x` in the
pattern synonym RHS. However, if the pattern synonym gets added to
the environment first, we will try and fail to find `x` amongst the
(nonexistent) fields of the pattern synonym.
Alternatively, the scope check can fail due to Template Haskell.
Consider (Trac #12130):
module Foo where
import M
b = $(funny)
module M(funny) where
data T = MkT { x :: Int }
funny :: Q Exp
funny = [| MkT { x = 3 } |]
When we splice, `MkT` is not lexically in scope, so
lookupGRE_FieldLabel will fail. But there is no need for
disambiguation anyway, because `x` is an original name, and
lookupGlobalOccRn will find it.
-}
-- | Used in export lists to lookup the children.
......
......@@ -53,15 +53,10 @@ import RnUtils ( HsDocContext(..), newLocalBndrRn, bindLocalNames
, warnUnusedMatches, newLocalBndrRn
, checkDupNames, checkDupAndShadowedNames
, checkTupSize , unknownSubordinateErr )
import RnUnbound ( mkUnboundName )
import RnTypes
import PrelNames
import TyCon ( tyConName )
import ConLike
import Type ( TyThing(..) )
import Name
import NameSet
import OccName ( setOccNameSpace, tcName )
import RdrName
import BasicTypes
import Util
......@@ -73,7 +68,7 @@ import TysWiredIn ( nilDataCon )
import DataCon
import qualified GHC.LanguageExtensions as LangExt
import Control.Monad ( when, liftM, ap )
import Control.Monad ( when, liftM, ap, guard )
import qualified Data.List.NonEmpty as NE
import Data.Ratio
......@@ -582,7 +577,7 @@ rnHsRecFields
rnHsRecFields ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot })
= do { pun_ok <- xoptM LangExt.RecordPuns
; disambig_ok <- xoptM LangExt.DisambiguateRecordFields
; parent <- check_disambiguation disambig_ok mb_con
; let parent = guard disambig_ok >> mb_con
; flds1 <- mapM (rn_fld pun_ok parent) flds
; mapM_ (addErr . dupFieldErr ctxt) dup_flds
; dotdot_flds <- rn_dotdot dotdot mb_con flds1
......@@ -595,17 +590,13 @@ rnHsRecFields ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot })
HsRecFieldPat con -> Just con
_ {- update -} -> Nothing
doc = case mb_con of
Nothing -> text "constructor field name"
Just con -> text "field of constructor" <+> quotes (ppr con)
rn_fld :: Bool -> Maybe Name -> LHsRecField GhcPs (Located arg)
-> RnM (LHsRecField GhcRn (Located arg))
rn_fld pun_ok parent (L l (HsRecField { hsRecFieldLbl
= L loc (FieldOcc _ (L ll lbl))
, hsRecFieldArg = arg
, hsRecPun = pun }))
= do { sel <- setSrcSpan loc $ lookupRecFieldOcc parent doc lbl
= do { sel <- setSrcSpan loc $ lookupRecFieldOcc parent lbl
; arg' <- if pun
then do { checkErr pun_ok (badPun (L loc lbl))
-- Discard any module qualifier (#11662)
......@@ -671,41 +662,6 @@ rnHsRecFields ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot })
-- _mb_con = Nothing => Record update
-- _mb_con = Just unbound => Out of scope data constructor
check_disambiguation :: Bool -> Maybe Name -> RnM (Maybe Name)
-- When disambiguation is on, return name of parent tycon.
check_disambiguation disambig_ok mb_con
| disambig_ok, Just con <- mb_con
= do { env <- getGlobalRdrEnv; return (find_tycon env con) }
| otherwise = return Nothing
find_tycon :: GlobalRdrEnv -> Name {- DataCon -}
-> Maybe Name {- TyCon -}
-- Return the parent *type constructor* of the data constructor
-- (that is, the parent of the data constructor),
-- or 'Nothing' if it is a pattern synonym or not in scope.
-- That's the parent to use for looking up record fields.
find_tycon env con_name
| isUnboundName con_name
= Just (mkUnboundName (setOccNameSpace tcName (getOccName con_name)))
-- If the data con is not in scope, return an unboundName tycon
-- That way the calls to lookupRecFieldOcc in rn_fld won't generate
-- an error cascade; see Trac #14307
| Just (AConLike (RealDataCon dc)) <- wiredInNameTyThing_maybe con_name
= Just (tyConName (dataConTyCon dc))
-- Special case for [], which is built-in syntax
-- and not in the GlobalRdrEnv (Trac #8448)
| Just gre <- lookupGRE_Name env con_name
= case gre_par gre of
ParentIs p -> Just p
_ -> Nothing -- Can happen if the con_name
-- is for a pattern synonym
| otherwise = Nothing
-- Data constructor not lexically in scope at all
-- See Note [Disambiguation and Template Haskell]
dup_flds :: [NE.NonEmpty RdrName]
-- Each list represents a RdrName that occurred more than once
-- (the list contains all occurrences)
......@@ -713,21 +669,12 @@ rnHsRecFields ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot })
(_, dup_flds) = removeDups compare (getFieldLbls flds)
{- Note [Disambiguation and Template Haskell]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider (Trac #12130)
module Foo where
import M
b = $(funny)
module M(funny) where
data T = MkT { x :: Int }
funny :: Q Exp
funny = [| MkT { x = 3 } |]
When we splice, neither T nor MkT are lexically in scope, so find_tycon will
fail. But there is no need for disambiguation anyway, so we just return Nothing
-}
-- 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.
rnHsRecUpdFields
:: [LHsRecUpdField GhcPs]
......
{-# LANGUAGE PatternSynonyms, DisambiguateRecordFields #-}
module T14747 where
import T14747A
pattern T{x} = [x]
e = S { x = 42 }
{-# LANGUAGE PatternSynonyms #-}
module T14747A where
pattern S{x} = [x]
{-# LANGUAGE DisambiguateRecordFields #-}
module Main where
import T15149B
import T15149C
main = do print (AnDouble{an=1}, AnInt{an=1})
{-# LANGUAGE TypeFamilies #-}
module T15149A where
data family An c :: *
{-# LANGUAGE TypeFamilies #-}
module T15149B where
import T15149A
data instance An Int = AnInt {an :: Int} deriving Show
{-# LANGUAGE TypeFamilies #-}
module T15149C where
import T15149A
data instance An Double = AnDouble {an :: Double} deriving Show
......@@ -154,3 +154,5 @@ test('T13132', normal, compile, [''])
test('T13646', normal, compile, [''])
test('LookupSub', [], multimod_compile, ['LookupSub', '-v0'])
test('T14881', [], multimod_compile, ['T14881', '-W'])
test('T14747', [], multimod_compile, ['T14747', '-v0'])
test('T15149', [], multimod_compile, ['T15149', '-v0'])
T8448.hs:5:21: ‘r’ is not a (visible) field of constructor ‘[]’
T8448.hs:5:17: error:
• Constructor ‘[]’ does not have field ‘r’
• In the first argument of ‘undefined’, namely ‘[] {r = x}’
In the expression: undefined [] {r = x}
In an equation for ‘f’: f x = undefined [] {r = x}
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