Commit 0a163741 authored by Adam Gundry's avatar Adam Gundry

Disambiguate record selectors by type signature

This makes DuplicateRecordFields more liberal in when it will
accept ambiguous record selectors, making use of type information in a
similar way to updates. See Note [Disambiguating record fields] for more
details. I've also refactored how record updates are disambiguated.

Test Plan: New and amended tests in overloadedrecflds

Reviewers: simonpj, goldfire, bgamari, austin

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D1391
parent 268aa9a2
......@@ -711,7 +711,7 @@ dsExpr (EViewPat {}) = panic "dsExpr:EViewPat"
dsExpr (ELazyPat {}) = panic "dsExpr:ELazyPat"
dsExpr (HsType {}) = panic "dsExpr:HsType"
dsExpr (HsDo {}) = panic "dsExpr:HsDo"
dsExpr (HsSingleRecFld{}) = panic "dsExpr: HsSingleRecFld"
dsExpr (HsRecFld {}) = panic "dsExpr:HsRecFld"
findField :: [LHsRecField Id arg] -> Name -> [arg]
......
......@@ -1073,6 +1073,10 @@ repE (HsVar x) =
; return (MkC e') } }
repE e@(HsIPVar _) = notHandled "Implicit parameters" (ppr e)
repE e@(HsRecFld f) = case f of
Unambiguous _ x -> repE (HsVar x)
Ambiguous{} -> notHandled "Ambiguous record selectors" (ppr e)
-- Remember, we're desugaring renamer output here, so
-- HsOverlit can definitely occur
repE (HsOverLit l) = do { a <- repOverloadedLiteral l; repLit a }
......@@ -1241,7 +1245,7 @@ repUpdFields = repList fieldExpQTyConName rep_fld
Unambiguous _ sel_name -> do { fn <- lookupLOcc (L l sel_name)
; e <- repLE (hsRecFieldArg fld)
; repFieldExp fn e }
_ -> notHandled "ambiguous record updates" (ppr fld)
_ -> notHandled "Ambiguous record updates" (ppr fld)
......
......@@ -135,7 +135,7 @@ data HsExpr id
-- Turned into HsVar by type checker, to support deferred
-- type errors. (The HsUnboundVar only has an OccName.)
| HsSingleRecFld (FieldOcc id) -- ^ Variable that corresponds to a record selector
| HsRecFld (AmbiguousFieldOcc id) -- ^ Variable pointing to record selector
| HsIPVar HsIPName -- ^ Implicit parameter
| HsOverLit (HsOverLit id) -- ^ Overloaded literals
......@@ -801,7 +801,7 @@ ppr_expr (HsArrForm (L _ (HsVar v)) (Just _) [arg1, arg2])
ppr_expr (HsArrForm op _ args)
= hang (ptext (sLit "(|") <+> ppr_lexpr op)
4 (sep (map (pprCmdArg.unLoc) args) <+> ptext (sLit "|)"))
ppr_expr (HsSingleRecFld f) = ppr f
ppr_expr (HsRecFld f) = ppr f
pprExternalSrcLoc :: (StringLiteral,(Int,Int),(Int,Int)) -> SDoc
pprExternalSrcLoc (StringLiteral _ src,(n1,n2),(n3,n4))
......@@ -853,7 +853,7 @@ hsExprNeedsParens (HsRnBracketOut {}) = False
hsExprNeedsParens (HsTcBracketOut {}) = False
hsExprNeedsParens (HsDo sc _ _)
| isListCompExpr sc = False
hsExprNeedsParens (HsSingleRecFld{}) = False
hsExprNeedsParens (HsRecFld{}) = False
hsExprNeedsParens _ = True
......@@ -866,7 +866,7 @@ isAtomicHsExpr (HsIPVar {}) = True
isAtomicHsExpr (HsUnboundVar {}) = True
isAtomicHsExpr (HsWrap _ e) = isAtomicHsExpr e
isAtomicHsExpr (HsPar e) = isAtomicHsExpr (unLoc e)
isAtomicHsExpr (HsSingleRecFld{}) = True
isAtomicHsExpr (HsRecFld{}) = True
isAtomicHsExpr _ = False
{-
......
......@@ -324,6 +324,8 @@ data HsRecField' id arg = HsRecField {
-- The typechecker will determine the particular selector:
--
-- hsRecFieldLbl = Unambiguous "x" $sel:x:MkS :: AmbiguousFieldOcc Id
--
-- See also Note [Disambiguating record fields] in TcExpr.
hsRecFields :: HsRecFields id arg -> [PostRn id id]
hsRecFields rbinds = map (unLoc . hsRecFieldSel . unLoc) (rec_flds rbinds)
......
......@@ -587,7 +587,8 @@ mkFieldOcc rdr = FieldOcc rdr PlaceHolder
-- (for unambiguous occurrences) or the typechecker (for ambiguous
-- occurrences).
--
-- See Note [HsRecField and HsRecUpdField] in HsPat
-- See Note [HsRecField and HsRecUpdField] in HsPat and
-- Note [Disambiguating record fields] in TcExpr.
data AmbiguousFieldOcc name
= Unambiguous RdrName (PostRn name name)
| Ambiguous RdrName (PostTc name name)
......@@ -615,7 +616,7 @@ unambiguousFieldOcc :: AmbiguousFieldOcc Id -> FieldOcc Id
unambiguousFieldOcc (Unambiguous rdr sel) = FieldOcc rdr sel
unambiguousFieldOcc (Ambiguous rdr sel) = FieldOcc rdr sel
ambiguousFieldOcc :: FieldOcc Id -> AmbiguousFieldOcc Id
ambiguousFieldOcc :: FieldOcc name -> AmbiguousFieldOcc name
ambiguousFieldOcc (FieldOcc rdr sel) = Unambiguous rdr sel
{-
......
......@@ -16,6 +16,7 @@ module RnEnv (
lookupGlobalOccRn, lookupGlobalOccRn_maybe,
lookupOccRn_overloaded, lookupGlobalOccRn_overloaded,
reportUnboundName, unknownNameSuggestions,
addNameClashErrRn,
HsSigCtxt(..), lookupLocalTcNames, lookupSigOccRn,
lookupSigCtxtOccRn,
......
......@@ -94,7 +94,8 @@ rnUnboundVar v
; return (HsVar n, emptyFVs) } }
rnExpr (HsVar v)
= do { mb_name <- lookupOccRn_overloaded False v
= do { opt_DuplicateRecordFields <- xoptM Opt_DuplicateRecordFields
; mb_name <- lookupOccRn_overloaded opt_DuplicateRecordFields v
; case mb_name of {
Nothing -> rnUnboundVar v ;
Just (Left name)
......@@ -104,8 +105,10 @@ rnExpr (HsVar v)
| otherwise
-> finishHsVar name ;
Just (Right (f:fs)) -> ASSERT( null fs )
return (HsSingleRecFld f, unitFV (selectorFieldOcc f)) ;
Just (Right [f]) -> return (HsRecFld (ambiguousFieldOcc f)
, unitFV (selectorFieldOcc f)) ;
Just (Right fs@(_:_:_)) -> return (HsRecFld (Ambiguous v PlaceHolder)
, mkFVs (map selectorFieldOcc fs));
Just (Right []) -> error "runExpr/HsVar" } }
rnExpr (HsIPVar v)
......
......@@ -672,7 +672,7 @@ rnHsRecUpdFields flds
= do { let lbl = rdrNameAmbiguousFieldOcc f
; sel <- setSrcSpan loc $
-- Defer renaming of overloaded fields to the typechecker
-- See Note [Disambiguating record updates] in TcExpr
-- See Note [Disambiguating record fields] in TcExpr
if overload_ok
then do { mb <- lookupGlobalOccRn_overloaded overload_ok lbl
; case mb of
......
......@@ -28,7 +28,9 @@ import BasicTypes
import Inst
import TcBinds
import FamInst ( tcGetFamInstEnvs, tcLookupDataFamInst )
import RnEnv ( addUsedGRE )
import FamInstEnv ( FamInstEnvs )
import RnEnv ( addUsedGRE, addNameClashErrRn
, unknownSubordinateErr )
import TcEnv
import TcArrows
import TcMatches
......@@ -693,7 +695,7 @@ following.
tcExpr (RecordUpd record_expr rbnds _ _ _ _ ) res_ty
= ASSERT( notNull rbnds )
do {
-- STEP -1 See Note [Disambiguating record updates]
-- STEP -1 See Note [Disambiguating record fields]
-- After this we know that rbinds is unambiguous
rbinds <- disambiguateRecordBinds record_expr rbnds res_ty
; let upd_flds = map (unLoc . hsRecFieldLbl . unLoc) rbinds
......@@ -826,7 +828,7 @@ tcExpr (RecordUpd record_expr rbnds _ _ _ _ ) res_ty
RecordUpd (mkLHsWrap scrut_co record_expr') rbinds'
relevant_cons scrut_inst_tys result_inst_tys req_wrap }
tcExpr (HsSingleRecFld f) res_ty
tcExpr (HsRecFld f) res_ty
= tcCheckRecSelId f res_ty
{-
......@@ -973,6 +975,14 @@ tcApp (L loc (HsVar fun)) args res_ty
, [arg1,arg2] <- args
= tcSeq loc fun arg1 arg2 res_ty
-- Look for applications of ambiguous record selectors to arguments
-- with type signatures, see Note [Disambiguating record fields]
tcApp (L loc (HsRecFld (Ambiguous lbl _))) args@(L _ arg:_) res_ty
| Just sig_ty <- obviousSig arg
= do { sig_tc_ty <- tcHsSigType ExprSigCtxt sig_ty
; sel_name <- disambiguateSelector lbl sig_tc_ty
; tcApp (L loc (HsRecFld (Unambiguous lbl sel_name))) args res_ty }
tcApp fun args res_ty
= do { -- Type-check the function
; (fun1, fun_tau) <- tcInferFun fun
......@@ -1011,7 +1021,7 @@ tcInferFun (L loc (HsVar name))
-- Don't wrap a context around a plain Id
; return (L loc fun, ty) }
tcInferFun (L loc (HsSingleRecFld f))
tcInferFun (L loc (HsRecFld f))
= do { (fun, ty) <- setSrcSpan loc (tcInferRecSelId f)
-- Don't wrap a context around a plain Id
; return (L loc fun, ty) }
......@@ -1108,19 +1118,27 @@ tcCheckId name res_ty
; addErrCtxtM (funResCtxt False (HsVar name) actual_res_ty res_ty) $
tcWrapResult expr actual_res_ty res_ty }
tcCheckRecSelId :: FieldOcc Name -> TcRhoType -> TcM (HsExpr TcId)
tcCheckRecSelId f res_ty
tcCheckRecSelId :: AmbiguousFieldOcc Name -> TcRhoType -> TcM (HsExpr TcId)
tcCheckRecSelId f@(Unambiguous _ _) res_ty
= do { (expr, actual_res_ty) <- tcInferRecSelId f
; addErrCtxtM (funResCtxt False (HsSingleRecFld f) actual_res_ty res_ty) $
; addErrCtxtM (funResCtxt False (HsRecFld f) actual_res_ty res_ty) $
tcWrapResult expr actual_res_ty res_ty }
tcCheckRecSelId (Ambiguous lbl _) res_ty
= case tcSplitFunTy_maybe res_ty of
Nothing -> ambiguousSelector lbl
Just (arg, _) -> do { sel_name <- disambiguateSelector lbl arg
; tcCheckRecSelId (Unambiguous lbl sel_name) res_ty }
------------------------
tcInferId :: Name -> TcM (HsExpr TcId, TcRhoType)
-- Infer type, and deeply instantiate
tcInferId n = tcInferIdWithOrig (OccurrenceOf n) (nameRdrName n) n
tcInferRecSelId :: FieldOcc Name -> TcM (HsExpr TcId, TcRhoType)
tcInferRecSelId (FieldOcc lbl sel) = tcInferIdWithOrig (OccurrenceOfRecSel lbl) lbl sel
tcInferRecSelId :: AmbiguousFieldOcc Name -> TcM (HsExpr TcId, TcRhoType)
tcInferRecSelId (Unambiguous lbl sel)
= tcInferIdWithOrig (OccurrenceOfRecSel lbl) lbl sel
tcInferRecSelId (Ambiguous lbl _)
= ambiguousSelector lbl
------------------------
tcInferIdWithOrig :: CtOrigin -> RdrName -> Name ->
......@@ -1407,15 +1425,15 @@ getFixedTyVars upd_fld_occs univ_tvs cons
, tv `elemVarSet` fixed_tvs ]
{-
Note [Disambiguating record updates]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Note [Disambiguating record fields]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
When the -XDuplicateRecordFields extension is used, and the renamer
encounters a record update that it cannot immediately disambiguate
(because it involves fields that belong to multiple datatypes), it
will defer resolution of the ambiguity to the typechecker. In this
case, the `hsRecUpdFieldSel` field of the `HsRecUpdField` stores a
list of candidate selectors.
encounters a record selector or update that it cannot immediately
disambiguate (because it involves fields that belong to multiple
datatypes), it will defer resolution of the ambiguity to the
typechecker. In this case, the `Ambiguous` constructor of
`AmbiguousFieldOcc` is used.
Consider the following definitions:
......@@ -1423,9 +1441,31 @@ Consider the following definitions:
data T = MkT { foo :: Int, bar :: Int }
data U = MkU { bar :: Int, baz :: Int }
When the renamer sees an update of `foo`, it will not know which
parent datatype is in use. The `disambiguateRecordBinds` function
tries to determine the parent in three ways:
When the renamer sees `foo` as a selector or an update, it will not
know which parent datatype is in use.
For selectors, there are two possible ways to disambiguate:
1. Check if the pushed-in type is a function whose domain is a
datatype, for example:
f s = (foo :: S -> Int) s
g :: T -> Int
g = foo
This is checked by `tcCheckRecSelId` when checking `HsRecFld foo`.
2. Check if the selector is applied to an argument that has a type
signature, for example:
h = foo (s :: S)
This is checked by `tcApp`.
Updates are slightly more complex. The `disambiguateRecordBinds`
function tries to determine the parent datatype in three ways:
1. Check for types that have all the fields being updated. For example:
......@@ -1450,10 +1490,13 @@ tries to determine the parent in three ways:
h x = (x :: T) { foo = 3 }
Note that we do not look up the types of variables being updated, and
no constraint-solving is performed, so for example the following will
be rejected as ambiguous:
let bad (s :: S) = foo s
let r :: T
r = blah
in r { foo = 3 }
......@@ -1462,107 +1505,162 @@ be rejected as ambiguous:
We could add further tests, of a more heuristic nature. For example,
rather than looking for an explicit signature, we could try to infer
the type of the record expression, in case we are lucky enough to get
a TyConApp straight away. However, it might be hard for programmers to
predict whether a particular update is sufficiently obvious for the
signature to be omitted.
the type of the argument to a selector or the record expression being
updated, in case we are lucky enough to get a TyConApp straight
away. However, it might be hard for programmers to predict whether a
particular update is sufficiently obvious for the signature to be
omitted. Moreover, this might change the behaviour of typechecker in
non-obvious ways.
See also Note [HsRecField and HsRecUpdField] in HsPat.
-}
-- Given a RdrName that refers to multiple record fields, and the type
-- of its argument, try to determine the name of the selector that is
-- meant.
disambiguateSelector :: RdrName -> Type -> RnM Name
disambiguateSelector rdr parent_type
= do { fam_inst_envs <- tcGetFamInstEnvs
; case tyConOf fam_inst_envs parent_type of
Nothing -> ambiguousSelector rdr
Just p ->
do { xs <- lookupParents rdr
; let parent = RecSelData p
; case lookup parent xs of
Just gre -> do { addUsedGRE True gre
; return (gre_name gre) }
Nothing -> failWithTc (fieldNotInType parent rdr) } }
-- This field name really is ambiguous, so add a suitable "ambiguous
-- occurrence" error, then give up.
ambiguousSelector :: RdrName -> RnM a
ambiguousSelector rdr
= do { env <- getGlobalRdrEnv
; let gres = lookupGRE_RdrName rdr env
; setErrCtxt [] $ addNameClashErrRn rdr gres
; failM }
-- Disambiguate the fields in a record update.
-- See Note [Disambiguating record fields]
disambiguateRecordBinds :: LHsExpr Name -> [LHsRecUpdField Name] -> Type
-> TcM [LHsRecField' (AmbiguousFieldOcc Id) (LHsExpr Name)]
disambiguateRecordBinds record_expr rbnds res_ty
-- Are all the fields unambiguous?
= case mapM isUnambiguous rbnds of
-- If so, just skip to looking up the Ids
-- Always the case if DuplicateRecordFields is off
Just rbnds' -> lookupSelectors rbnds'
Nothing -> do
{ fam_inst_envs <- tcGetFamInstEnvs
; (rbnds_with_parents) <- fmap (zip rbnds) $ mapM getParents rbnds
; (p :: RecSelParent) <- case possibleParents (map snd rbnds_with_parents) of
Just rbnds' -> mapM lookupSelector rbnds'
Nothing -> -- If not, try to identify a single parent
do { fam_inst_envs <- tcGetFamInstEnvs
-- Look up the possible parents for each field
; rbnds_with_parents <- getUpdFieldsParents
; let possible_parents = map (map fst . snd) rbnds_with_parents
-- Identify a single parent
; p <- identifyParent fam_inst_envs possible_parents
-- Pick the right selector with that parent for each field
; checkNoErrs $ mapM (pickParent p) rbnds_with_parents }
where
-- Extract the selector name of a field update if it is unambiguous
isUnambiguous :: LHsRecUpdField Name -> Maybe (LHsRecUpdField Name, Name)
isUnambiguous x = case unLoc (hsRecFieldLbl (unLoc x)) of
Unambiguous _ sel_name -> Just (x, sel_name)
Ambiguous{} -> Nothing
-- Look up the possible parents and selector GREs for each field
getUpdFieldsParents :: TcM [(LHsRecUpdField Name
, [(RecSelParent, GlobalRdrElt)])]
getUpdFieldsParents
= fmap (zip rbnds) $ mapM
(lookupParents . unLoc . hsRecUpdFieldRdr . unLoc)
rbnds
-- Given a the lists of possible parents for each field,
-- identify a single parent
identifyParent :: FamInstEnvs -> [[RecSelParent]] -> TcM RecSelParent
identifyParent fam_inst_envs possible_parents
= case foldr1 intersect possible_parents of
-- No parents for all fields: record update is ill-typed
[] -> failWithTc (noPossibleParents rbnds)
-- Exactly one datatype with all the fields: use that
[p] -> return p
_ | Just p <- tyConOf fam_inst_envs res_ty -> return (RecSelData p)
_ | Just sig_ty <- obviousSig (unLoc record_expr) ->
do { sig_tc_ty <- tcHsSigType ExprSigCtxt sig_ty
-- Multiple possible parents: try harder to disambiguate
-- Can we get a parent TyCon from the pushed-in type?
_:_ | Just p <- tyConOf fam_inst_envs res_ty -> return (RecSelData p)
-- Does the expression being updated have a type signature?
-- If so, try to extract a parent TyCon from it
| Just sig_ty <- obviousSig (unLoc record_expr)
-> do { sig_tc_ty <- tcHsSigType ExprSigCtxt sig_ty
; case tyConOf fam_inst_envs sig_tc_ty of
Just p -> return (RecSelData p)
Nothing -> failWithTc badOverloadedUpdate }
-- Nothing else we can try...
_ -> failWithTc badOverloadedUpdate
; assignParent p rbnds_with_parents }
where
isUnambiguous :: LHsRecUpdField Name -> Maybe (LHsRecUpdField Name, Name)
isUnambiguous x = case unLoc (hsRecFieldLbl (unLoc x)) of
Unambiguous _ sel_name -> Just (x, sel_name)
Ambiguous{} -> Nothing
lookupSelectors :: [(LHsRecUpdField Name, Name)] -> TcM [LHsRecField' (AmbiguousFieldOcc Id) (LHsExpr Name)]
lookupSelectors = mapM look
where
look :: (LHsRecUpdField Name, Name) -> TcM (LHsRecField' (AmbiguousFieldOcc Id) (LHsExpr Name))
look (L l x, n) = do i <- tcLookupId n
let L loc af = hsRecFieldLbl x
-- Make a field unambiguous by choosing the given parent.
-- Emits an error if the field cannot have that parent,
-- e.g. if the user writes
-- r { x = e } :: T
-- where T does not have field x.
pickParent :: RecSelParent
-> (LHsRecUpdField Name, [(RecSelParent, GlobalRdrElt)])
-> TcM (LHsRecField' (AmbiguousFieldOcc Id) (LHsExpr Name))
pickParent p (upd, xs)
= case lookup p xs of
-- Phew! The parent is valid for this field.
-- Previously ambiguous fields must be marked as
-- used now that we know which one is meant, but
-- unambiguous ones shouldn't be recorded again
-- (giving duplicate deprecation warnings).
Just gre -> do { unless (null (tail xs)) $ do
let L loc _ = hsRecFieldLbl (unLoc upd)
setSrcSpan loc $ addUsedGRE True gre
; lookupSelector (upd, gre_name gre) }
-- The field doesn't belong to this parent, so report
-- an error but keep going through all the fields
Nothing -> do { addErrTc (fieldNotInType p
(unLoc (hsRecUpdFieldRdr (unLoc upd))))
; lookupSelector (upd, gre_name (snd (head xs))) }
-- Given a (field update, selector name) pair, look up the
-- selector to give a field update with an unambiguous Id
lookupSelector :: (LHsRecUpdField Name, Name)
-> TcM (LHsRecField' (AmbiguousFieldOcc Id) (LHsExpr Name))
lookupSelector (L l upd, n)
= do { i <- tcLookupId n
; let L loc af = hsRecFieldLbl upd
lbl = rdrNameAmbiguousFieldOcc af
return $ L l x { hsRecFieldLbl = L loc (Unambiguous lbl i) }
; return $ L l upd { hsRecFieldLbl = L loc (Unambiguous lbl i) } }
-- Extract the outermost TyCon of a type, if there is one; for
-- data families this is the representation tycon (because that's
-- where the fields live).
tyConOf fam_inst_envs ty = case tcSplitTyConApp_maybe ty of
-- Extract the outermost TyCon of a type, if there is one; for
-- data families this is the representation tycon (because that's
-- where the fields live).
tyConOf :: FamInstEnvs -> Type -> Maybe TyCon
tyConOf fam_inst_envs ty = case tcSplitTyConApp_maybe ty of
Just (tc, tys) -> Just (fstOf3 (tcLookupDataFamInst fam_inst_envs tc tys))
Nothing -> Nothing
-- Calculate the list of possible parent tycons, by taking the
-- intersection of the possibilities for each field.
possibleParents :: [[(RecSelParent, a)]] -> [RecSelParent]
possibleParents = foldr1 intersect . map (map fst)
-- Look up the parent tycon for each candidate record selector.
getParents :: LHsRecUpdField Name -> RnM [(RecSelParent, GlobalRdrElt)]
getParents (L _ fld) = do
{ env <- getGlobalRdrEnv
; let gres = lookupGRE_RdrName (unLoc (hsRecUpdFieldRdr fld)) env
-- For an ambiguous record field, find all the candidate record
-- selectors (as GlobalRdrElts) and their parents.
lookupParents :: RdrName -> RnM [(RecSelParent, GlobalRdrElt)]
lookupParents rdr
= do { env <- getGlobalRdrEnv
; let gres = lookupGRE_RdrName rdr env
; mapM lookupParent gres }
where
lookupParent :: GlobalRdrElt -> RnM (RecSelParent, GlobalRdrElt)
lookupParent gre = do { id <- tcLookupId (gre_name gre)
; ASSERT(isRecordSelector id)
return (recordSelectorTyCon id, gre) }
-- Make all the fields unambiguous by choosing the given parent.
-- Fails with an error if any of the ambiguous fields cannot have
-- that parent, e.g. if the user writes
-- r { x = e } :: T
-- where T does not have field x.
assignParent :: RecSelParent -> [(LHsRecUpdField Name, [(RecSelParent, GlobalRdrElt)])]
-> RnM [LHsRecField' (AmbiguousFieldOcc Id) (LHsExpr Name)]
assignParent p rbnds
| null orphans = do rbnds'' <- mapM f rbnds'
lookupSelectors rbnds''
| otherwise = failWithTc (orphanFields p orphans)
where
(orphans, rbnds') = partitionWith pickParent rbnds
-- Previously ambiguous fields must be marked as used now that
-- we know which one is meant, but unambiguous ones shouldn't
-- be recorded again (giving duplicate deprecation warnings).
f (fld, gre, was_unambiguous)
= do { unless was_unambiguous $ do
setSrcSpan (getLoc fld) $ addUsedGRE True gre
; return (fld, gre_name gre) }
-- Returns Right if fld can have parent p, or Left lbl if not.
pickParent :: (LHsRecUpdField Name, [(RecSelParent, GlobalRdrElt)])
-> Either (Located RdrName) (LHsRecUpdField Name, GlobalRdrElt, Bool)
pickParent (fld, xs)
= case lookup p xs of
Just gre -> Right (fld, gre, null (tail xs))
Nothing -> Left (hsRecUpdFieldRdr (unLoc fld))
; if isRecordSelector id
then return (recordSelectorTyCon id, gre)
else failWithTc (notSelector (gre_name gre)) }
-- A type signature on the record expression must be "obvious",
-- i.e. the outermost constructor ignoring parentheses.
obviousSig :: HsExpr Name -> Maybe (LHsType Name)
obviousSig (ExprWithTySig _ ty _) = Just ty
obviousSig (HsPar p) = obviousSig (unLoc p)
obviousSig _ = Nothing
-- A type signature on the argument of an ambiguous record selector or
-- the record expression in an update must be "obvious", i.e. the
-- outermost constructor ignoring parentheses.
obviousSig :: HsExpr Name -> Maybe (LHsType Name)
obviousSig (ExprWithTySig _ ty _) = Just ty
obviousSig (HsPar p) = obviousSig (unLoc p)
obviousSig _ = Nothing
{-
......@@ -1886,8 +1984,6 @@ noPossibleParents rbinds
badOverloadedUpdate :: SDoc
badOverloadedUpdate = ptext (sLit "Record update is ambiguous, and requires a type signature")
orphanFields :: RecSelParent -> [Located RdrName] -> SDoc
orphanFields p flds
= hang (ptext (sLit "Type") <+> ppr p <+>
ptext (sLit "does not have field") <> plural flds <> colon)
2 (pprQuotedList flds)
fieldNotInType :: RecSelParent -> RdrName -> SDoc
fieldNotInType p rdr
= unknownSubordinateErr (ptext (sLit "field of type") <+> quotes (ppr p)) rdr
......@@ -20,3 +20,5 @@ test('overloadedrecfldsfail11', normal, compile_fail, [''])
test('overloadedrecfldsfail12',
extra_clean(['OverloadedRecFldsFail12_A.hi', 'OverloadedRecFldsFail12_A.o']),
multimod_compile_fail, ['overloadedrecfldsfail12', ''])
test('overloadedrecfldsfail13', normal, compile_fail, [''])
test('overloadedrecfldsfail14', normal, compile_fail, [''])
overloadedrecfldsfail01.hs:11:10:
overloadedrecfldsfail01.hs:11:10: error:
Record update is ambiguous, and requires a type signature
In the expression: r {x = 3}
In an equation for ‘upd1’: upd1 r = r {x = 3}
overloadedrecfldsfail01.hs:14:10:
overloadedrecfldsfail01.hs:14:10: error:
No type has all these fields: ‘x’, ‘y’, ‘z’
In the expression: r {x = 3, y = True, z = False}
In an equation for ‘upd2’: upd2 r = r {x = 3, y = True, z = False}
overloadedrecfldsfail01.hs:17:10:
Type U does not have fields: ‘w’, ‘x’
overloadedrecfldsfail01.hs:17:10: error:
‘w’ is not a (visible) field of type ‘U’
In the expression: r {w = True, x = 3, y = True} :: U
In an equation for ‘upd3’:
upd3 r = r {w = True, x = 3, y = True} :: U
overloadedrecfldsfail01.hs:17:10: error:
‘x’ is not a (visible) field of type ‘U’
In the expression: r {w = True, x = 3, y = True} :: U
In an equation for ‘upd3’:
upd3 r = r {w = True, x = 3, y = True} :: U
......@@ -10,3 +10,5 @@ x' = I.x
-- But this is okay
f e = e { I.x = True, I.y = False }
main = return ()
overloadedrecfldsfail09.hs:9:11: error:
ambiguous record updates not (yet) handled by Template Haskell
Ambiguous record updates not (yet) handled by Template Haskell
x = 3
......@@ -9,4 +9,7 @@ data S = MkS { foo :: Bool }
f :: T -> T
f e = e { foo = 3, bar = 3 }
s :: T -> Int
s = foo
main = return ()
......@@ -9,5 +9,9 @@ overloadedrecfldsfail12.hs:10:20: warning:
In the use of ‘bar’ (imported from OverloadedRecFldsFail12_A):
"Deprecated bar"
overloadedrecfldsfail12.hs:13:5: warning:
In the use of ‘foo’ (imported from OverloadedRecFldsFail12_A):
"Deprecated foo"
<no location info>: error:
Failing due to -Werror.
-- Test that giving a stupid type annotation to an ambiguous field
-- yields a sensible error message
{-# LANGUAGE DuplicateRecordFields #-}
data S = MkS { x :: Int }
data T = MkT { x :: Bool }
data U = MkU