summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorShayne Fletcher <shayne@shaynefletcher.org>2021-04-24 16:59:26 -0400
committerShayne Fletcher <shayne@shaynefletcher.org>2021-05-23 08:02:58 +1000
commit0b1eed74e8ad5194152ed656ac3e4a547726b70a (patch)
tree3e654267d7077050a2358910ebe0ef29cfdddb0d
parentef4d2999a200f22c864d7c1a2bdfbfd726a0f849 (diff)
downloadhaskell-0b1eed74e8ad5194152ed656ac3e4a547726b70a.tar.gz
Change representation of field selector occurences
- Change the names of the fields in in `data FieldOcc` - Renames `HsRecFld` to `HsRecSel` - Replace `AmbiguousFieldOcc p` in `HsRecSel` with `FieldOcc p` - Contains a haddock submodule update The primary motivation of this change is to remove `AmbiguousFieldOcc`. This is one of a suite of changes improving how record syntax (most notably record update syntax) is represented in the AST.
-rw-r--r--compiler/GHC/Hs/Expr.hs17
-rw-r--r--compiler/GHC/Hs/Pat.hs2
-rw-r--r--compiler/GHC/Hs/Utils.hs4
-rw-r--r--compiler/GHC/HsToCore/Coverage.hs3
-rw-r--r--compiler/GHC/HsToCore/Docs.hs2
-rw-r--r--compiler/GHC/HsToCore/Expr.hs3
-rw-r--r--compiler/GHC/HsToCore/Quote.hs12
-rw-r--r--compiler/GHC/Iface/Ext/Ast.hs6
-rw-r--r--compiler/GHC/Parser/Annotation.hs5
-rw-r--r--compiler/GHC/Rename/Bind.hs4
-rw-r--r--compiler/GHC/Rename/Env.hs24
-rw-r--r--compiler/GHC/Rename/Expr.hs16
-rw-r--r--compiler/GHC/Rename/Fixity.hs45
-rw-r--r--compiler/GHC/Rename/HsType.hs14
-rw-r--r--compiler/GHC/Rename/Module.hs2
-rw-r--r--compiler/GHC/Rename/Pat.hs2
-rw-r--r--compiler/GHC/Tc/Gen/App.hs9
-rw-r--r--compiler/GHC/Tc/Gen/Expr.hs9
-rw-r--r--compiler/GHC/Tc/Gen/Head.hs270
-rw-r--r--compiler/GHC/Tc/Types/Origin.hs2
-rw-r--r--compiler/GHC/Tc/Utils/Zonk.hs6
-rw-r--r--compiler/Language/Haskell/Syntax/Binds.hs3
-rw-r--r--compiler/Language/Haskell/Syntax/Expr.hs64
-rw-r--r--compiler/Language/Haskell/Syntax/Extension.hs2
-rw-r--r--compiler/Language/Haskell/Syntax/Pat.hs2
-rw-r--r--compiler/Language/Haskell/Syntax/Type.hs49
-rw-r--r--testsuite/tests/backpack/should_compile/T13323.bkp2
-rw-r--r--testsuite/tests/backpack/should_compile/T13323.stderr10
-rw-r--r--testsuite/tests/overloadedrecflds/should_fail/DRFUnused.stderr13
-rw-r--r--testsuite/tests/overloadedrecflds/should_fail/T11167_ambiguous_fixity.stderr24
-rw-r--r--testsuite/tests/overloadedrecflds/should_fail/T13132_duplicaterecflds.stderr18
-rw-r--r--testsuite/tests/overloadedrecflds/should_fail/all.T1
-rw-r--r--testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail02.stderr6
-rw-r--r--testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail04.stderr15
-rw-r--r--testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail11.stderr18
-rw-r--r--testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail12.stderr34
-rw-r--r--testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail13.stderr34
-rw-r--r--testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldswasrunnowfail06.hs (renamed from testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun06.hs)0
-rw-r--r--testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldswasrunnowfail06.stderr40
-rw-r--r--testsuite/tests/overloadedrecflds/should_run/all.T1
-rw-r--r--testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun06.stdout2
-rw-r--r--testsuite/tests/rename/should_compile/T11167_ambig.stderr11
-rw-r--r--testsuite/tests/rename/should_compile/all.T1
-rw-r--r--testsuite/tests/rename/should_fail/T11167_ambig.hs (renamed from testsuite/tests/rename/should_compile/T11167_ambig.hs)0
-rw-r--r--testsuite/tests/rename/should_fail/T11167_ambig.stderr12
-rw-r--r--testsuite/tests/rename/should_fail/all.T1
-rw-r--r--utils/check-exact/ExactPrint.hs4
m---------utils/haddock0
48 files changed, 350 insertions, 474 deletions
diff --git a/compiler/GHC/Hs/Expr.hs b/compiler/GHC/Hs/Expr.hs
index 9b409f4232..a25f90d0b0 100644
--- a/compiler/GHC/Hs/Expr.hs
+++ b/compiler/GHC/Hs/Expr.hs
@@ -218,7 +218,13 @@ data EpAnnUnboundVar = EpAnnUnboundVar
} deriving Data
type instance XVar (GhcPass _) = NoExtField
-type instance XRecFld (GhcPass _) = NoExtField
+
+-- Record selectors at parse time are HsVar; they convert to HsRecSel
+-- on renaming.
+type instance XRecSel GhcPs = Void
+type instance XRecSel GhcRn = NoExtField
+type instance XRecSel GhcTc = NoExtField
+
type instance XLam (GhcPass _) = NoExtField
-- OverLabel not present in GhcTc pass; see GHC.Rename.Expr
@@ -239,7 +245,6 @@ type instance XUnboundVar GhcTc = HoleExprRef
-- Much, much easier just to define HoleExprRef with a Data instance and
-- store the whole structure.
-type instance XRecFld (GhcPass _) = NoExtField
type instance XIPVar (GhcPass _) = EpAnnCO
type instance XOverLitE (GhcPass _) = EpAnnCO
type instance XLitE (GhcPass _) = EpAnnCO
@@ -486,7 +491,7 @@ ppr_expr :: forall p. (OutputableBndrId p)
=> HsExpr (GhcPass p) -> SDoc
ppr_expr (HsVar _ (L _ v)) = pprPrefixOcc v
ppr_expr (HsUnboundVar _ uv) = pprPrefixOcc uv
-ppr_expr (HsRecFld _ f) = pprPrefixOcc f
+ppr_expr (HsRecSel _ f) = pprPrefixOcc f
ppr_expr (HsIPVar _ v) = ppr v
ppr_expr (HsOverLabel _ l) = char '#' <> ppr l
ppr_expr (HsLit _ lit) = ppr lit
@@ -683,7 +688,7 @@ instance Outputable XXExprGhcTc where
ppr_infix_expr :: forall p. (OutputableBndrId p) => HsExpr (GhcPass p) -> Maybe SDoc
ppr_infix_expr (HsVar _ (L _ v)) = Just (pprInfixOcc v)
-ppr_infix_expr (HsRecFld _ f) = Just (pprInfixOcc f)
+ppr_infix_expr (HsRecSel _ f) = Just (pprInfixOcc f)
ppr_infix_expr (HsUnboundVar _ occ) = Just (pprInfixOcc occ)
ppr_infix_expr (XExpr x) = case ghcPass @p of
#if __GLASGOW_HASKELL__ < 901
@@ -786,7 +791,7 @@ hsExprNeedsParens prec = go
go (HsTick _ _ (L _ e)) = go e
go (HsBinTick _ _ _ (L _ e)) = go e
go (RecordCon{}) = False
- go (HsRecFld{}) = False
+ go (HsRecSel{}) = False
go (HsProjection{}) = True
go (HsGetField{}) = False
go (XExpr x) = case ghcPass @p of
@@ -828,7 +833,7 @@ isAtomicHsExpr (HsOverLit {}) = True
isAtomicHsExpr (HsIPVar {}) = True
isAtomicHsExpr (HsOverLabel {}) = True
isAtomicHsExpr (HsUnboundVar {}) = True
-isAtomicHsExpr (HsRecFld{}) = True
+isAtomicHsExpr (HsRecSel{}) = True
isAtomicHsExpr (XExpr x)
| GhcTc <- ghcPass @p = go_x_tc x
| GhcRn <- ghcPass @p = go_x_rn x
diff --git a/compiler/GHC/Hs/Pat.hs b/compiler/GHC/Hs/Pat.hs
index 1b9b7817e0..239c57418b 100644
--- a/compiler/GHC/Hs/Pat.hs
+++ b/compiler/GHC/Hs/Pat.hs
@@ -223,7 +223,7 @@ hsRecUpdFieldRdr :: HsRecUpdField (GhcPass p) -> Located RdrName
hsRecUpdFieldRdr = fmap rdrNameAmbiguousFieldOcc . hfbLHS
hsRecUpdFieldId :: HsFieldBind (LAmbiguousFieldOcc GhcTc) arg -> Located Id
-hsRecUpdFieldId = fmap extFieldOcc . hsRecUpdFieldOcc
+hsRecUpdFieldId = fmap foExt . hsRecUpdFieldOcc
hsRecUpdFieldOcc :: HsFieldBind (LAmbiguousFieldOcc GhcTc) arg -> LFieldOcc GhcTc
hsRecUpdFieldOcc = fmap unambiguousFieldOcc . hfbLHS
diff --git a/compiler/GHC/Hs/Utils.hs b/compiler/GHC/Hs/Utils.hs
index 524071154f..4f9e5c83bc 100644
--- a/compiler/GHC/Hs/Utils.hs
+++ b/compiler/GHC/Hs/Utils.hs
@@ -1342,7 +1342,7 @@ hsTyClForeignBinders tycl_decls foreign_decls
foldMap (foldMap hsLInstDeclBinders . group_instds) tycl_decls)
where
getSelectorNames :: ([LocatedA Name], [LFieldOcc GhcRn]) -> [Name]
- getSelectorNames (ns, fs) = map unLoc ns ++ map (extFieldOcc . unLoc) fs
+ getSelectorNames (ns, fs) = map unLoc ns ++ map (foExt . unLoc) fs
-------------------
hsLTyClDeclBinders :: IsPass p
@@ -1491,7 +1491,7 @@ hsConDeclsBinders cons
where
fld_names = remSeen (concatMap (cd_fld_names . unLoc) (unLoc flds))
remSeen' = foldr (.) remSeen
- [deleteBy ((==) `on` unLoc . rdrNameFieldOcc . unLoc) v
+ [deleteBy ((==) `on` unLoc . foLabel . unLoc) v
| v <- fld_names]
{-
diff --git a/compiler/GHC/HsToCore/Coverage.hs b/compiler/GHC/HsToCore/Coverage.hs
index e2aa7607b6..fbb14ce28f 100644
--- a/compiler/GHC/HsToCore/Coverage.hs
+++ b/compiler/GHC/HsToCore/Coverage.hs
@@ -518,8 +518,7 @@ addBinTickLHsExpr boxLabel (L pos e0)
addTickHsExpr :: HsExpr GhcTc -> TM (HsExpr GhcTc)
addTickHsExpr e@(HsVar _ (L _ id)) = do freeVar id; return e
addTickHsExpr e@(HsUnboundVar {}) = return e
-addTickHsExpr e@(HsRecFld _ (Ambiguous id _)) = do freeVar id; return e
-addTickHsExpr e@(HsRecFld _ (Unambiguous id _)) = do freeVar id; return e
+addTickHsExpr e@(HsRecSel _ (FieldOcc id _)) = do freeVar id; return e
addTickHsExpr e@(HsIPVar {}) = return e
addTickHsExpr e@(HsOverLit {}) = return e
diff --git a/compiler/GHC/HsToCore/Docs.hs b/compiler/GHC/HsToCore/Docs.hs
index 0dd6267db6..df2e334213 100644
--- a/compiler/GHC/HsToCore/Docs.hs
+++ b/compiler/GHC/HsToCore/Docs.hs
@@ -209,7 +209,7 @@ subordinates instMap decl = case decl of
, maybeToList $ fmap unLoc $ con_doc c
, conArgDocs c)
| c <- cons, cname <- getConNames c ]
- fields = [ (extFieldOcc n, maybeToList $ fmap unLoc doc, IM.empty)
+ fields = [ (foExt n, maybeToList $ fmap unLoc doc, IM.empty)
| Just flds <- map getRecConArgs_maybe cons
, (L _ (ConDeclField _ ns _ doc)) <- (unLoc flds)
, (L _ n) <- ns ]
diff --git a/compiler/GHC/HsToCore/Expr.hs b/compiler/GHC/HsToCore/Expr.hs
index 75e72d6d9c..e89ab4868b 100644
--- a/compiler/GHC/HsToCore/Expr.hs
+++ b/compiler/GHC/HsToCore/Expr.hs
@@ -266,8 +266,7 @@ dsLExprNoLP (L loc e)
dsExpr :: HsExpr GhcTc -> DsM CoreExpr
dsExpr (HsVar _ (L _ id)) = dsHsVar id
-dsExpr (HsRecFld _ (Unambiguous id _)) = dsHsVar id
-dsExpr (HsRecFld _ (Ambiguous id _)) = dsHsVar id
+dsExpr (HsRecSel _ (FieldOcc id _)) = dsHsVar id
dsExpr (HsUnboundVar (HER ref _ _) _) = dsEvTerm =<< readMutVar ref
-- See Note [Holes] in GHC.Tc.Types.Constraint
diff --git a/compiler/GHC/HsToCore/Quote.hs b/compiler/GHC/HsToCore/Quote.hs
index 50e8458726..21e70cf53c 100644
--- a/compiler/GHC/HsToCore/Quote.hs
+++ b/compiler/GHC/HsToCore/Quote.hs
@@ -284,7 +284,7 @@ repTopDs group@(HsGroup { hs_valds = valds
, hs_docs = docs })
= do { let { bndrs = hsScopedTvBinders valds
++ hsGroupBinders group
- ++ map extFieldOcc (hsPatSynSelectors valds)
+ ++ map foExt (hsPatSynSelectors valds)
; instds = tyclds >>= group_instds } ;
ss <- mkGenSyms bndrs ;
@@ -1486,9 +1486,7 @@ repE (HsVar _ (L _ x)) =
repE (HsIPVar _ n) = rep_implicit_param_name n >>= repImplicitParamVar
repE (HsOverLabel _ s) = repOverLabel s
-repE e@(HsRecFld _ f) = case f of
- Unambiguous x _ -> repE (HsVar noExtField (noLocA x))
- Ambiguous{} -> notHandled "Ambiguous record selectors" (ppr e)
+repE (HsRecSel _ (FieldOcc x _)) = repE (HsVar noExtField (noLocA x))
-- Remember, we're desugaring renamer output here, so
-- HsOverlit can definitely occur
@@ -1929,7 +1927,7 @@ rep_bind (L loc (PatSynBind _ (PSB { psb_id = syn
mkGenArgSyms (InfixCon arg1 arg2) = mkGenSyms [unLoc arg1, unLoc arg2]
mkGenArgSyms (RecCon fields)
= do { let pats = map (unLoc . recordPatSynPatVar) fields
- sels = map (extFieldOcc . recordPatSynField) fields
+ sels = map (foExt . recordPatSynField) fields
; ss <- mkGenSyms sels
; return $ replaceNames (zip sels pats) ss }
@@ -1959,7 +1957,7 @@ repPatSynArgs (InfixCon arg1 arg2)
; arg2' <- lookupLOcc arg2
; repInfixPatSynArgs arg1' arg2' }
repPatSynArgs (RecCon fields)
- = do { sels' <- repList nameTyConName (lookupOcc . extFieldOcc) sels
+ = do { sels' <- repList nameTyConName (lookupOcc . foExt) sels
; repRecordPatSynArgs sels' }
where sels = map recordPatSynField fields
@@ -2706,7 +2704,7 @@ repRecConArgs ips = do
rep_ip (L _ ip) = mapM (rep_one_ip (cd_fld_type ip)) (cd_fld_names ip)
rep_one_ip :: LBangType GhcRn -> LFieldOcc GhcRn -> MetaM (Core (M TH.VarBangType))
- rep_one_ip t n = do { MkC v <- lookupOcc (extFieldOcc $ unLoc n)
+ rep_one_ip t n = do { MkC v <- lookupOcc (foExt $ unLoc n)
; MkC ty <- repBangTy t
; rep2 varBangTypeName [v,ty] }
diff --git a/compiler/GHC/Iface/Ext/Ast.hs b/compiler/GHC/Iface/Ext/Ast.hs
index 573cba529d..bbfd7294c5 100644
--- a/compiler/GHC/Iface/Ext/Ast.hs
+++ b/compiler/GHC/Iface/Ext/Ast.hs
@@ -771,7 +771,7 @@ instance HiePass p => HasType (LocatedA (HsExpr (GhcPass p))) where
skipDesugaring :: HsExpr GhcTc -> Bool
skipDesugaring e = case e of
HsVar{} -> False
- HsRecFld{} -> False
+ HsRecSel{} -> False
HsOverLabel{} -> False
HsIPVar{} -> False
XExpr (WrapExpr {}) -> False
@@ -902,7 +902,7 @@ instance HiePass p => ToHie (Located (PatSynBind (GhcPass p) (GhcPass p))) where
(InfixCon a b) -> combineScopes (mkLScopeN a) (mkLScopeN b)
(RecCon r) -> foldr go NoScope r
go (RecordPatSynField a b) c = combineScopes c
- $ combineScopes (mkLScopeN (rdrNameFieldOcc a)) (mkLScopeN b)
+ $ combineScopes (mkLScopeN (foLabel a)) (mkLScopeN b)
detSpan = case detScope of
LocalScope a -> Just a
_ -> Nothing
@@ -1082,7 +1082,7 @@ instance HiePass p => ToHie (LocatedA (HsExpr (GhcPass p))) where
-- Patch up var location since typechecker removes it
]
HsUnboundVar _ _ -> [] -- there is an unbound name here, but that causes trouble
- HsRecFld _ fld ->
+ HsRecSel _ fld ->
[ toHie $ RFC RecFieldOcc Nothing (L (locA mspan) fld)
]
HsOverLabel {} -> []
diff --git a/compiler/GHC/Parser/Annotation.hs b/compiler/GHC/Parser/Annotation.hs
index ab88285274..20ac4bde62 100644
--- a/compiler/GHC/Parser/Annotation.hs
+++ b/compiler/GHC/Parser/Annotation.hs
@@ -1213,6 +1213,11 @@ instance (Outputable a, Outputable e)
=> Outputable (GenLocated (SrcSpanAnn' a) e) where
ppr = pprLocated
+instance (Outputable a, OutputableBndr e)
+ => OutputableBndr (GenLocated (SrcSpanAnn' a) e) where
+ pprInfixOcc = pprInfixOcc . unLoc
+ pprPrefixOcc = pprPrefixOcc . unLoc
+
instance Outputable AnnListItem where
ppr (AnnListItem ts) = text "AnnListItem" <+> ppr ts
diff --git a/compiler/GHC/Rename/Bind.hs b/compiler/GHC/Rename/Bind.hs
index 1bd7a583b4..609ab180f9 100644
--- a/compiler/GHC/Rename/Bind.hs
+++ b/compiler/GHC/Rename/Bind.hs
@@ -706,7 +706,7 @@ rnPatSynBind sig_fn bind@(PSB { psb_id = L l name
; return ( (pat', InfixCon name1 name2)
, mkFVs (map unLoc [name1, name2])) }
RecCon vars ->
- do { checkDupRdrNames (map (rdrNameFieldOcc . recordPatSynField) vars)
+ do { checkDupRdrNames (map (foLabel . recordPatSynField) vars)
; fls <- lookupConstructorFields name
; let fld_env = mkFsEnv [ (flLabel fl, fl) | fl <- fls ]
; let rnRecordPatSynField
@@ -742,7 +742,7 @@ rnPatSynBind sig_fn bind@(PSB { psb_id = L l name
, psb_ext = fvs' }
selector_names = case details' of
RecCon names ->
- map (extFieldOcc . recordPatSynField) names
+ map (foExt . recordPatSynField) names
_ -> []
; fvs' `seq` -- See Note [Free-variable space leak]
diff --git a/compiler/GHC/Rename/Env.hs b/compiler/GHC/Rename/Env.hs
index 957b118b88..ba9a851171 100644
--- a/compiler/GHC/Rename/Env.hs
+++ b/compiler/GHC/Rename/Env.hs
@@ -1199,21 +1199,17 @@ lookupOccRn_maybe = lookupOccRnX_maybe lookupGlobalOccRn_maybe id
--
-- This may be a local variable, global variable, or one or more record selector
-- functions. It will not return record fields created with the
--- @NoFieldSelectors@ extension (see Note [NoFieldSelectors]). The
--- 'DuplicateRecordFields' argument controls whether ambiguous fields will be
--- allowed (resulting in an 'AmbiguousFields' result being returned).
+-- @NoFieldSelectors@ extension (see Note [NoFieldSelectors]).
--
-- If the name is not in scope at the term level, but its promoted equivalent is
-- in scope at the type level, the lookup will succeed (so that the type-checker
-- can report a more informative error later). See Note [Promotion].
--
-lookupExprOccRn
- :: DuplicateRecordFields -> RdrName
- -> RnM (Maybe AmbiguousResult)
-lookupExprOccRn dup_fields_ok rdr_name
- = do { mb_name <- lookupOccRnX_maybe global_lookup (UnambiguousGre . NormalGreName) rdr_name
+lookupExprOccRn :: RdrName -> RnM (Maybe GreName)
+lookupExprOccRn rdr_name
+ = do { mb_name <- lookupOccRnX_maybe global_lookup NormalGreName rdr_name
; case mb_name of
- Nothing -> fmap @Maybe (UnambiguousGre . NormalGreName) <$> lookup_promoted rdr_name
+ Nothing -> fmap @Maybe NormalGreName <$> lookup_promoted rdr_name
-- See Note [Promotion].
-- We try looking up the name as a
-- type constructor or type variable, if
@@ -1221,8 +1217,14 @@ lookupExprOccRn dup_fields_ok rdr_name
p -> return p }
where
- global_lookup :: RdrName -> RnM (Maybe AmbiguousResult)
- global_lookup = lookupGlobalOccRn_overloaded dup_fields_ok WantNormal
+ global_lookup :: RdrName -> RnM (Maybe GreName)
+ global_lookup rdr_name =
+ do { mb_name <- lookupGlobalOccRn_overloaded NoDuplicateRecordFields WantNormal rdr_name
+ ; case mb_name of
+ Just (UnambiguousGre name) -> return (Just name)
+ Just _ -> panic "GHC.Rename.Env.global_lookup: The impossible happened!"
+ Nothing -> return Nothing
+ }
lookupGlobalOccRn_maybe :: RdrName -> RnM (Maybe Name)
-- Looks up a RdrName occurrence in the top-level
diff --git a/compiler/GHC/Rename/Expr.hs b/compiler/GHC/Rename/Expr.hs
index bdcd7a4151..dce75ba1f2 100644
--- a/compiler/GHC/Rename/Expr.hs
+++ b/compiler/GHC/Rename/Expr.hs
@@ -211,12 +211,11 @@ rnUnboundVar v =
rnExpr (HsVar _ (L l v))
= do { dflags <- getDynFlags
- ; let dup_fields_ok = xopt_DuplicateRecordFields dflags
- ; mb_name <- lookupExprOccRn dup_fields_ok v
+ ; mb_name <- lookupExprOccRn v
; case mb_name of {
Nothing -> rnUnboundVar v ;
- Just (UnambiguousGre (NormalGreName name))
+ Just (NormalGreName name)
| name == nilDataConName -- Treat [] as an ExplicitList, so that
-- OverloadedLists works correctly
-- Note [Empty lists] in GHC.Hs.Expr
@@ -225,12 +224,11 @@ rnExpr (HsVar _ (L l v))
| otherwise
-> finishHsVar (L (na2la l) name) ;
- Just (UnambiguousGre (FieldGreName fl)) ->
+ Just (FieldGreName fl) ->
let sel_name = flSelector fl in
- return ( HsRecFld noExtField (Unambiguous sel_name (L l v) ), unitFV sel_name) ;
- Just AmbiguousFields ->
- return ( HsRecFld noExtField (Ambiguous noExtField (L l v) ), emptyFVs) } }
-
+ return ( HsRecSel noExtField (FieldOcc sel_name (L l v) ), unitFV sel_name) ;
+ }
+ }
rnExpr (HsIPVar x v)
= return (HsIPVar x v, emptyFVs)
@@ -292,7 +290,7 @@ rnExpr (OpApp _ e1 op e2)
-- should prevent bad things happening.
; fixity <- case op' of
L _ (HsVar _ (L _ n)) -> lookupFixityRn n
- L _ (HsRecFld _ f) -> lookupFieldFixityRn f
+ L _ (HsRecSel _ f) -> lookupFieldFixityRn f
_ -> return (Fixity NoSourceText minPrecedence InfixL)
-- c.f. lookupFixity for unbound
diff --git a/compiler/GHC/Rename/Fixity.hs b/compiler/GHC/Rename/Fixity.hs
index e45f3a5cdb..39462baf36 100644
--- a/compiler/GHC/Rename/Fixity.hs
+++ b/compiler/GHC/Rename/Fixity.hs
@@ -30,15 +30,11 @@ import GHC.Types.SourceText
import GHC.Types.SrcLoc
import GHC.Utils.Outputable
-import GHC.Utils.Panic
import GHC.Data.Maybe
import GHC.Rename.Unbound
-import Data.List (groupBy)
-import Data.Function ( on )
-
{-
*********************************************************
* *
@@ -184,39 +180,10 @@ lookupFixityRn_help' name occ
lookupTyFixityRn :: LocatedN Name -> RnM Fixity
lookupTyFixityRn = lookupFixityRn . unLoc
--- | Look up the fixity of a (possibly ambiguous) occurrence of a record field
--- selector. We use 'lookupFixityRn'' so that we can specify the 'OccName' as
--- the field label, which might be different to the 'OccName' of the selector
--- 'Name' if @DuplicateRecordFields@ is in use (#1173). If there are
--- multiple possible selectors with different fixities, generate an error.
-lookupFieldFixityRn :: AmbiguousFieldOcc GhcRn -> RnM Fixity
-lookupFieldFixityRn (Unambiguous n lrdr)
+-- | Look up the fixity of an occurrence of a record field selector.
+-- We use 'lookupFixityRn'' so that we can specify the 'OccName' as
+-- the field label, which might be different to the 'OccName' of the
+-- selector 'Name' if @DuplicateRecordFields@ is in use (#1173).
+lookupFieldFixityRn :: FieldOcc GhcRn -> RnM Fixity
+lookupFieldFixityRn (FieldOcc n lrdr)
= lookupFixityRn' n (rdrNameOcc (unLoc lrdr))
-lookupFieldFixityRn (Ambiguous _ lrdr) = get_ambiguous_fixity (unLoc lrdr)
- where
- get_ambiguous_fixity :: RdrName -> RnM Fixity
- get_ambiguous_fixity rdr_name = do
- traceRn "get_ambiguous_fixity" (ppr rdr_name)
- rdr_env <- getGlobalRdrEnv
- let elts = lookupGRE_RdrName rdr_name rdr_env
-
- fixities <- groupBy ((==) `on` snd) . zip elts
- <$> mapM lookup_gre_fixity elts
-
- case fixities of
- -- There should always be at least one fixity.
- -- Something's very wrong if there are no fixity candidates, so panic
- [] -> panic "get_ambiguous_fixity: no candidates for a given RdrName"
- [ (_, fix):_ ] -> return fix
- ambigs -> addErr (ambiguous_fixity_err rdr_name ambigs)
- >> return (Fixity NoSourceText minPrecedence InfixL)
-
- lookup_gre_fixity gre = lookupFixityRn' (greMangledName gre) (greOccName gre)
-
- ambiguous_fixity_err rn ambigs
- = vcat [ text "Ambiguous fixity for record field" <+> quotes (ppr rn)
- , hang (text "Conflicts: ") 2 . vcat .
- map format_ambig $ concat ambigs ]
-
- format_ambig (elt, fix) = hang (ppr fix)
- 2 (pprNameProvenance elt)
diff --git a/compiler/GHC/Rename/HsType.hs b/compiler/GHC/Rename/HsType.hs
index f912ce84fa..92228b0003 100644
--- a/compiler/GHC/Rename/HsType.hs
+++ b/compiler/GHC/Rename/HsType.hs
@@ -1393,11 +1393,10 @@ mkOpAppRn e1 op fix e2 -- Default case, no rearrangment
----------------------------
-- | Name of an operator in an operator application or section
-data OpName = NormalOp Name -- ^ A normal identifier
- | NegateOp -- ^ Prefix negation
- | UnboundOp OccName -- ^ An unbound indentifier
- | RecFldOp (AmbiguousFieldOcc GhcRn)
- -- ^ A (possibly ambiguous) record field occurrence
+data OpName = NormalOp Name -- ^ A normal identifier
+ | NegateOp -- ^ Prefix negation
+ | UnboundOp OccName -- ^ An unbound indentifier
+ | RecFldOp (FieldOcc GhcRn) -- ^ A record field occurrence
instance Outputable OpName where
ppr (NormalOp n) = ppr n
@@ -1410,7 +1409,7 @@ get_op :: LHsExpr GhcRn -> OpName
-- See GHC.Rename.Expr.rnUnboundVar
get_op (L _ (HsVar _ n)) = NormalOp (unLoc n)
get_op (L _ (HsUnboundVar _ uv)) = UnboundOp uv
-get_op (L _ (HsRecFld _ fld)) = RecFldOp fld
+get_op (L _ (HsRecSel _ fld)) = RecFldOp fld
get_op other = pprPanic "get_op" (ppr other)
-- Parser left-associates everything, but
@@ -1574,8 +1573,7 @@ checkSectionPrec direction section op arg
(arg_op, arg_fix) section)
-- | Look up the fixity for an operator name. Be careful to use
--- 'lookupFieldFixityRn' for (possibly ambiguous) record fields
--- (see #13132).
+-- 'lookupFieldFixityRn' for record fields (see #13132).
lookupFixityOp :: OpName -> RnM Fixity
lookupFixityOp (NormalOp n) = lookupFixityRn n
lookupFixityOp NegateOp = lookupFixityRn negateName
diff --git a/compiler/GHC/Rename/Module.hs b/compiler/GHC/Rename/Module.hs
index 25bca4c0a2..61aa6a54d2 100644
--- a/compiler/GHC/Rename/Module.hs
+++ b/compiler/GHC/Rename/Module.hs
@@ -2435,7 +2435,7 @@ extendPatSynEnv dup_fields_ok has_sel val_decls local_fix_env thing = do {
, psb_args = RecCon as }))) <- bind
= do
bnd_name <- newTopSrcBinder (L (l2l bind_loc) n)
- let field_occs = map ((\ f -> L (getLocA (rdrNameFieldOcc f)) f) . recordPatSynField) as
+ let field_occs = map ((\ f -> L (getLocA (foLabel f)) f) . recordPatSynField) as
flds <- mapM (newRecordSelector dup_fields_ok has_sel [bnd_name]) field_occs
return ((bnd_name, flds): names)
| L bind_loc (PatSynBind _ (PSB { psb_id = L _ n})) <- bind
diff --git a/compiler/GHC/Rename/Pat.hs b/compiler/GHC/Rename/Pat.hs
index e9943c8be7..5e0723d4cb 100644
--- a/compiler/GHC/Rename/Pat.hs
+++ b/compiler/GHC/Rename/Pat.hs
@@ -803,7 +803,7 @@ getFieldIds flds = map (hsRecFieldSel . unLoc) flds
getFieldLbls :: forall p arg . UnXRec p => [LHsRecField p arg] -> [RdrName]
getFieldLbls flds
- = map (unLoc . rdrNameFieldOcc . unXRec @p . hfbLHS . unXRec @p) flds
+ = map (unXRec @p . foLabel . unXRec @p . hfbLHS . unXRec @p) flds
getFieldUpdLbls :: [LHsRecUpdField GhcPs] -> [RdrName]
getFieldUpdLbls flds = map (rdrNameAmbiguousFieldOcc . unLoc . hfbLHS . unLoc) flds
diff --git a/compiler/GHC/Tc/Gen/App.hs b/compiler/GHC/Tc/Gen/App.hs
index 76fdb7c5f5..4fee7b1a6e 100644
--- a/compiler/GHC/Tc/Gen/App.hs
+++ b/compiler/GHC/Tc/Gen/App.hs
@@ -138,7 +138,7 @@ tcInferSigma inst (L loc rn_expr)
= addExprCtxt rn_expr $
setSrcSpanA loc $
do { do_ql <- wantQuickLook rn_fun
- ; (_tc_fun, fun_sigma) <- tcInferAppHead fun rn_args Nothing
+ ; (_tc_fun, fun_sigma) <- tcInferAppHead fun rn_args
; (_delta, inst_args, app_res_sigma) <- tcInstFun do_ql inst fun fun_sigma rn_args
; _tc_args <- tcValArgs do_ql inst_args
; return app_res_sigma }
@@ -163,7 +163,7 @@ app :: head
| {-# PRAGMA #-} app -- HsPragE: pragmas
head ::= f -- HsVar: variables
- | fld -- HsRecFld: record field selectors
+ | fld -- HsRecSel: record field selectors
| (expr :: ty) -- ExprWithTySig: expr with user type sig
| lit -- HsOverLit: overloaded literals
| other_expr -- Other expressions
@@ -226,7 +226,7 @@ tcApp works like this:
2. Use tcInferAppHead to infer the type of the function,
as an (uninstantiated) TcSigmaType
There are special cases for
- HsVar, HsRecFld, and ExprWithTySig
+ HsVar, HsRecSel, and ExprWithTySig
Otherwise, delegate back to tcExpr, which
infers an (instantiated) TcRhoType
@@ -311,7 +311,6 @@ tcApp :: HsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc)
tcApp rn_expr exp_res_ty
| (fun@(rn_fun, fun_ctxt), rn_args) <- splitHsApps rn_expr
= do { (tc_fun, fun_sigma) <- tcInferAppHead fun rn_args
- (checkingExpType_maybe exp_res_ty)
-- Instantiate
; do_ql <- wantQuickLook rn_fun
@@ -852,7 +851,7 @@ quickLookArg1 :: Bool -> Delta -> LHsExpr GhcRn -> TcSigmaType
-> TcM (Delta, EValArg 'TcpInst)
quickLookArg1 guarded delta larg@(L _ arg) arg_ty
= do { let (fun@(rn_fun, fun_ctxt), rn_args) = splitHsApps arg
- ; mb_fun_ty <- tcInferAppHead_maybe rn_fun rn_args (Just arg_ty)
+ ; mb_fun_ty <- tcInferAppHead_maybe rn_fun rn_args
; traceTc "quickLookArg 1" $
vcat [ text "arg:" <+> ppr arg
, text "head:" <+> ppr rn_fun <+> dcolon <+> ppr mb_fun_ty
diff --git a/compiler/GHC/Tc/Gen/Expr.hs b/compiler/GHC/Tc/Gen/Expr.hs
index e9fbad3807..94a36def48 100644
--- a/compiler/GHC/Tc/Gen/Expr.hs
+++ b/compiler/GHC/Tc/Gen/Expr.hs
@@ -23,7 +23,6 @@ module GHC.Tc.Gen.Expr
tcPolyExpr, tcExpr,
tcSyntaxOp, tcSyntaxOpGen, SyntaxOpType(..), synKnownType,
tcCheckId,
- addAmbiguousNameErr,
getFixedTyVars ) where
import GHC.Prelude
@@ -184,7 +183,7 @@ tcExpr :: HsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc)
-- - HsApp value applications
-- - HsAppType type applications
-- - ExprWithTySig (e :: type)
--- - HsRecFld overloaded record fields
+-- - HsRecSel overloaded record fields
-- - HsExpanded renamer expansions
-- - HsOpApp operator applications
-- - HsOverLit overloaded literals
@@ -197,7 +196,7 @@ tcExpr e@(HsApp {}) res_ty = tcApp e res_ty
tcExpr e@(OpApp {}) res_ty = tcApp e res_ty
tcExpr e@(HsAppType {}) res_ty = tcApp e res_ty
tcExpr e@(ExprWithTySig {}) res_ty = tcApp e res_ty
-tcExpr e@(HsRecFld {}) res_ty = tcApp e res_ty
+tcExpr e@(HsRecSel {}) res_ty = tcApp e res_ty
tcExpr e@(XExpr (HsExpanded {})) res_ty = tcApp e res_ty
tcExpr e@(HsOverLit _ lit) res_ty
@@ -974,7 +973,7 @@ tcSyntaxOpGen :: CtOrigin
-> ([TcSigmaType] -> [Mult] -> TcM a)
-> TcM (a, SyntaxExprTc)
tcSyntaxOpGen orig (SyntaxExprRn op) arg_tys res_ty thing_inside
- = do { (expr, sigma) <- tcInferAppHead (op, VACall op 0 noSrcSpan) [] Nothing
+ = do { (expr, sigma) <- tcInferAppHead (op, VACall op 0 noSrcSpan) []
-- Ugh!! But all this code is scheduled for demolition anyway
; traceTc "tcSyntaxOpGen" (ppr op $$ ppr expr $$ ppr sigma)
; (result, expr_wrap, arg_wraps, res_wrap)
@@ -1371,7 +1370,7 @@ tcRecordUpd con_like arg_tys rbinds = fmap catMaybes $ mapM do_bind rbinds
return (Just
(L l (fld { hfbLHS
= L loc (Unambiguous
- (extFieldOcc (unLoc f'))
+ (foExt (unLoc f'))
(L (noAnnSrcSpan loc) lbl))
, hfbRHS = rhs' }))) }
diff --git a/compiler/GHC/Tc/Gen/Head.hs b/compiler/GHC/Tc/Gen/Head.hs
index b800583416..d018332e80 100644
--- a/compiler/GHC/Tc/Gen/Head.hs
+++ b/compiler/GHC/Tc/Gen/Head.hs
@@ -24,7 +24,7 @@ module GHC.Tc.Gen.Head
, tcInferAppHead, tcInferAppHead_maybe
, tcInferId, tcCheckId
- , obviousSig, addAmbiguousNameErr
+ , obviousSig
, tyConOf, tyConOfET, lookupParents, fieldNotInType
, notSelector, nonBidirectionalErr
@@ -40,11 +40,10 @@ import GHC.Tc.Utils.Monad
import GHC.Tc.Utils.Unify
import GHC.Types.Basic
import GHC.Tc.Utils.Instantiate
-import GHC.Tc.Instance.Family ( tcGetFamInstEnvs, tcLookupDataFamInst )
+import GHC.Tc.Instance.Family ( tcLookupDataFamInst )
import GHC.Core.FamInstEnv ( FamInstEnvs )
import GHC.Core.UsageEnv ( unitUE )
-import GHC.Rename.Env ( addUsedGRE )
-import GHC.Rename.Utils ( addNameClashErrRn, unknownSubordinateErr )
+import GHC.Rename.Utils ( unknownSubordinateErr )
import GHC.Tc.Errors.Types
import GHC.Tc.Solver ( InferMode(..), simplifyInfer )
import GHC.Tc.Utils.Env
@@ -77,7 +76,6 @@ import GHC.Utils.Panic.Plain
import Control.Monad
import Data.Function
-import qualified Data.List.NonEmpty as NE
import GHC.Prelude
@@ -373,22 +371,21 @@ It's easy to achieve this: `splitHsApps` unwraps `HsExpanded`.
********************************************************************* -}
tcInferAppHead :: (HsExpr GhcRn, AppCtxt)
- -> [HsExprArg 'TcpRn] -> Maybe TcRhoType
- -- These two args are solely for tcInferRecSelId
+ -> [HsExprArg 'TcpRn]
-> TcM (HsExpr GhcTc, TcSigmaType)
-- Infer type of the head of an application
-- i.e. the 'f' in (f e1 ... en)
-- See Note [Application chains and heads] in GHC.Tc.Gen.App
-- We get back a /SigmaType/ because we have special cases for
-- * A bare identifier (just look it up)
--- This case also covers a record selector HsRecFld
+-- This case also covers a record selector HsRecSel
-- * An expression with a type signature (e :: ty)
-- See Note [Application chains and heads] in GHC.Tc.Gen.App
--
--- Why do we need the arguments to infer the type of the head of
--- the application? For two reasons:
--- * (Legitimate) The first arg has the source location of the head
--- * (Disgusting) Needed for record disambiguation; see tcInferRecSelId
+-- Why do we need the arguments to infer the type of the head of the
+-- application? Simply to inform add_head_ctxt about whether or not
+-- to put push a new "In the expression..." context. (We don't push a
+-- new one if there are no arguments, because we already have.)
--
-- Note that [] and (,,) are both HsVar:
-- see Note [Empty lists] and [ExplicitTuple] in GHC.Hs.Expr
@@ -397,24 +394,23 @@ tcInferAppHead :: (HsExpr GhcRn, AppCtxt)
-- cases are dealt with by splitHsApps.
--
-- See Note [tcApp: typechecking applications] in GHC.Tc.Gen.App
-tcInferAppHead (fun,ctxt) args mb_res_ty
+tcInferAppHead (fun,ctxt) args
= setSrcSpan (appCtxtLoc ctxt) $
- do { mb_tc_fun <- tcInferAppHead_maybe fun args mb_res_ty
+ do { mb_tc_fun <- tcInferAppHead_maybe fun args
; case mb_tc_fun of
Just (fun', fun_sigma) -> return (fun', fun_sigma)
Nothing -> add_head_ctxt fun args $
tcInfer (tcExpr fun) }
tcInferAppHead_maybe :: HsExpr GhcRn
- -> [HsExprArg 'TcpRn] -> Maybe TcRhoType
- -- These two args are solely for tcInferRecSelId
+ -> [HsExprArg 'TcpRn]
-> TcM (Maybe (HsExpr GhcTc, TcSigmaType))
-- See Note [Application chains and heads] in GHC.Tc.Gen.App
-- Returns Nothing for a complicated head
-tcInferAppHead_maybe fun args mb_res_ty
+tcInferAppHead_maybe fun args
= case fun of
HsVar _ (L _ nm) -> Just <$> tcInferId nm
- HsRecFld _ f -> Just <$> tcInferRecSelId f args mb_res_ty
+ HsRecSel _ f -> Just <$> tcInferRecSelId f
ExprWithTySig _ e hs_ty -> add_head_ctxt fun args $
Just <$> tcExprWithSig e hs_ty
HsOverLit _ lit -> Just <$> tcInferOverLit lit
@@ -434,217 +430,39 @@ add_head_ctxt fun args thing_inside
* *
********************************************************************* -}
-{-
-Note [Deprecating ambiguous fields]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-In the future, the -XDuplicateRecordFields extension will no longer support
-disambiguating record fields during type-checking (as described in Note
-[Disambiguating record fields]). For now, the -Wambiguous-fields option will
-emit a warning whenever an ambiguous field is resolved using type information.
-In a subsequent GHC release, this functionality will be removed and the warning
-will turn into an ambiguity error in the renamer.
-
-For background information, see GHC proposal #366
-(https://github.com/ghc-proposals/ghc-proposals/pull/366).
-
-
-Note [Disambiguating record fields]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-NB. The following is going to be removed: see
-Note [Deprecating ambiguous fields].
-
-When the -XDuplicateRecordFields extension is used, and the renamer
-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:
-
- data S = MkS { foo :: Int }
- data T = MkT { foo :: Int, bar :: Int }
- data U = MkU { bar :: Int, baz :: Int }
-
-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 `tcInferRecSelId`.
-
-
-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:
-
- f x = x { foo = 3, bar = 2 }
-
- Here `f` must be updating `T` because neither `S` nor `U` have
- both fields. This may also discover that no possible type exists.
- For example the following will be rejected:
-
- f' x = x { foo = 3, baz = 3 }
-
-2. Use the type being pushed in, if it is already a TyConApp. The
- following are valid updates to `T`:
-
- g :: T -> T
- g x = x { foo = 3 }
-
- g' x = x { foo = 3 } :: T
-
-3. Use the type signature of the record expression, if it exists and
- is a TyConApp. Thus this is valid update to `T`:
-
- 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 }
-
- \r. (r { foo = 3 }, r :: T )
-
-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 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 GHC.Hs.Pat.
--}
-
-tcInferRecSelId :: AmbiguousFieldOcc GhcRn
- -> [HsExprArg 'TcpRn] -> Maybe TcRhoType
+tcInferRecSelId :: FieldOcc GhcRn
-> TcM (HsExpr GhcTc, TcSigmaType)
-tcInferRecSelId (Unambiguous sel_name lbl) _args _mb_res_ty
- = do { sel_id <- tc_rec_sel_id lbl sel_name
- ; let expr = HsRecFld noExtField (Unambiguous sel_id lbl)
- ; return (expr, idType sel_id) }
-
-tcInferRecSelId (Ambiguous _ lbl) args mb_res_ty
- = do { sel_name <- tcInferAmbiguousRecSelId lbl args mb_res_ty
- ; sel_id <- tc_rec_sel_id lbl sel_name
- ; let expr = HsRecFld noExtField (Ambiguous sel_id lbl)
- ; return (expr, idType sel_id) }
+tcInferRecSelId (FieldOcc sel_name lbl)
+ = do { sel_id <- tc_rec_sel_id
+ ; let expr = HsRecSel noExtField (FieldOcc sel_id lbl)
+ ; return (expr, idType sel_id)
+ }
+ where
+ occ :: OccName
+ occ = rdrNameOcc (unLoc lbl)
+
+ tc_rec_sel_id :: TcM TcId
+ -- Like tc_infer_id, but returns an Id not a HsExpr,
+ -- so we can wrap it back up into a HsRecSel
+ tc_rec_sel_id
+ = do { thing <- tcLookup sel_name
+ ; case thing of
+ ATcId { tct_id = id }
+ -> do { check_naughty occ id
+ ; check_local_id id
+ ; return id }
+
+ AGlobal (AnId id)
+ -> do { check_naughty occ id
+ ; return id }
+ -- A global cannot possibly be ill-staged
+ -- nor does it need the 'lifting' treatment
+ -- hence no checkTh stuff here
+
+ _ -> failWithTc $
+ ppr thing <+> text "used where a value identifier was expected" }
------------------------
-tc_rec_sel_id :: LocatedN RdrName -> Name -> TcM TcId
--- Like tc_infer_id, but returns an Id not a HsExpr,
--- so we can wrap it back up into a HsRecFld
-tc_rec_sel_id lbl sel_name
- = do { thing <- tcLookup sel_name
- ; case thing of
- ATcId { tct_id = id }
- -> do { check_naughty occ id
- ; check_local_id id
- ; return id }
-
- AGlobal (AnId id)
- -> do { check_naughty occ id
- ; return id }
- -- A global cannot possibly be ill-staged
- -- nor does it need the 'lifting' treatment
- -- hence no checkTh stuff here
-
- _ -> failWithTc $
- ppr thing <+> text "used where a value identifier was expected" }
- where
- occ = rdrNameOcc (unLoc lbl)
-
-------------------------
-tcInferAmbiguousRecSelId :: LocatedN RdrName
- -> [HsExprArg 'TcpRn] -> Maybe TcRhoType
- -> TcM Name
--- Disgusting special case for ambiguous record selectors
--- 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.
--- See Note [Disambiguating record fields]
-tcInferAmbiguousRecSelId lbl args mb_res_ty
- | arg1 : _ <- dropWhile (not . isVisibleArg) args -- A value arg is first
- , EValArg { eva_arg = ValArg (L _ arg) } <- arg1
- , Just sig_ty <- obviousSig arg -- A type sig on the arg disambiguates
- = do { sig_tc_ty <- tcHsSigWcType (ExprSigCtxt NoRRC) sig_ty
- ; finish_ambiguous_selector lbl sig_tc_ty }
-
- | Just res_ty <- mb_res_ty
- , Just (arg_ty,_) <- tcSplitFunTy_maybe res_ty
- = finish_ambiguous_selector lbl (scaledThing arg_ty)
-
- | otherwise
- = ambiguousSelector lbl
-
-finish_ambiguous_selector :: LocatedN RdrName -> Type -> TcM Name
-finish_ambiguous_selector lr@(L _ rdr) parent_type
- = do { fam_inst_envs <- tcGetFamInstEnvs
- ; case tyConOf fam_inst_envs parent_type of {
- Nothing -> ambiguousSelector lr ;
- Just p ->
-
- do { xs <- lookupParents True rdr
- ; let parent = RecSelData p
- ; case lookup parent xs of {
- Nothing -> failWithTc (fieldNotInType parent rdr) ;
- Just gre ->
-
- -- See Note [Unused name reporting and HasField] in GHC.Tc.Instance.Class
- do { addUsedGRE True gre
- ; keepAlive (greMangledName gre)
- -- See Note [Deprecating ambiguous fields]
- ; warnIfFlag Opt_WarnAmbiguousFields True $
- vcat [ text "The field" <+> quotes (ppr rdr)
- <+> text "belonging to type" <+> ppr parent_type
- <+> text "is ambiguous."
- , text "This will not be supported by -XDuplicateRecordFields in future releases of GHC."
- , if isLocalGRE gre
- then text "You can use explicit case analysis to resolve the ambiguity."
- else text "You can use a qualified import or explicit case analysis to resolve the ambiguity."
- ]
- ; return (greMangledName gre) } } } } }
-
--- This field name really is ambiguous, so add a suitable "ambiguous
--- occurrence" error, then give up.
-ambiguousSelector :: LocatedN RdrName -> TcM a
-ambiguousSelector (L _ rdr)
- = do { addAmbiguousNameErr rdr
- ; failM }
-
--- | This name really is ambiguous, so add a suitable "ambiguous
--- occurrence" error, then continue
-addAmbiguousNameErr :: RdrName -> TcM ()
-addAmbiguousNameErr rdr
- = do { env <- getGlobalRdrEnv
- ; let gres = lookupGRE_RdrName rdr env
- ; case gres of
- [] -> panic "addAmbiguousNameErr: not found"
- gre : gres -> setErrCtxt [] $ addNameClashErrRn rdr $ gre NE.:| gres}
-- A type signature on the argument of an ambiguous record selector or
-- the record expression in an update must be "obvious", i.e. the
diff --git a/compiler/GHC/Tc/Types/Origin.hs b/compiler/GHC/Tc/Types/Origin.hs
index 0f5d74e27e..44ade07fcb 100644
--- a/compiler/GHC/Tc/Types/Origin.hs
+++ b/compiler/GHC/Tc/Types/Origin.hs
@@ -497,7 +497,7 @@ exprCtOrigin :: HsExpr GhcRn -> CtOrigin
exprCtOrigin (HsVar _ (L _ name)) = OccurrenceOf name
exprCtOrigin (HsGetField _ _ (L _ f)) = HasFieldOrigin (unLoc $ hflLabel f)
exprCtOrigin (HsUnboundVar {}) = Shouldn'tHappenOrigin "unbound variable"
-exprCtOrigin (HsRecFld _ f) = OccurrenceOfRecSel (rdrNameAmbiguousFieldOcc f)
+exprCtOrigin (HsRecSel _ f) = OccurrenceOfRecSel (unLoc $ foLabel f)
exprCtOrigin (HsOverLabel _ l) = OverLabelOrigin l
exprCtOrigin (ExplicitList {}) = ListOrigin
exprCtOrigin (HsIPVar _ ip) = IPOccOrigin ip
diff --git a/compiler/GHC/Tc/Utils/Zonk.hs b/compiler/GHC/Tc/Utils/Zonk.hs
index c20bb08aac..a11fe41f6a 100644
--- a/compiler/GHC/Tc/Utils/Zonk.hs
+++ b/compiler/GHC/Tc/Utils/Zonk.hs
@@ -805,10 +805,8 @@ zonkExpr env (HsUnboundVar her occ)
ty' <- zonkTcTypeToTypeX env ty
return (HER ref ty' u)
-zonkExpr env (HsRecFld _ (Ambiguous v occ))
- = return (HsRecFld noExtField (Ambiguous (zonkIdOcc env v) occ))
-zonkExpr env (HsRecFld _ (Unambiguous v occ))
- = return (HsRecFld noExtField (Unambiguous (zonkIdOcc env v) occ))
+zonkExpr env (HsRecSel _ (FieldOcc v occ))
+ = return (HsRecSel noExtField (FieldOcc (zonkIdOcc env v) occ))
zonkExpr _ (HsIPVar x id)
= return (HsIPVar x id)
diff --git a/compiler/Language/Haskell/Syntax/Binds.hs b/compiler/Language/Haskell/Syntax/Binds.hs
index 8c69f10eb8..60ca3fad1b 100644
--- a/compiler/Language/Haskell/Syntax/Binds.hs
+++ b/compiler/Language/Haskell/Syntax/Binds.hs
@@ -33,6 +33,7 @@ import {-# SOURCE #-} Language.Haskell.Syntax.Pat
import Language.Haskell.Syntax.Extension
import Language.Haskell.Syntax.Type
+import GHC.Types.Name.Reader(RdrName)
import GHC.Tc.Types.Evidence
import GHC.Core.Type
import GHC.Types.Basic
@@ -931,7 +932,7 @@ when we have a different name for the local and top-level binder,
making the distinction between the two names clear.
-}
-instance Outputable (RecordPatSynField a) where
+instance Outputable (XRec a RdrName) => Outputable (RecordPatSynField a) where
ppr (RecordPatSynField { recordPatSynField = v }) = ppr v
diff --git a/compiler/Language/Haskell/Syntax/Expr.hs b/compiler/Language/Haskell/Syntax/Expr.hs
index a9592304e6..6f5150a1b4 100644
--- a/compiler/Language/Haskell/Syntax/Expr.hs
+++ b/compiler/Language/Haskell/Syntax/Expr.hs
@@ -267,6 +267,55 @@ is Less Cool because
typecheck do-notation with (>>=) :: m1 a -> (a -> m2 b) -> m2 b.)
-}
+{-
+Note [Record selectors in the AST]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Here is how record selectors are expressed in GHC's AST:
+
+Example data type
+ data T = MkT { size :: Int }
+
+Record selectors:
+ | GhcPs | GhcRn | GhcTc |
+----------------------------------------------------------------------------------|
+size (assuming one | HsVar | HsRecSel | HsRecSel |
+ 'size' in scope) | | | |
+----------------------|--------------|----------------------|---------------------|
+.size (assuming | HsProjection | getField @"size" | getField @"size" |
+ OverloadedRecordDot) | | | |
+----------------------|--------------|----------------------|---------------------|
+e.size (assuming | HsGetField | getField @"size" e | getField @"size" e |
+ OverloadedRecordDot) | | | |
+
+NB 1: DuplicateRecordFields makes no difference to the first row of
+this table, except that if 'size' is a field of more than one data
+type, then a naked use of the record selector 'size' may well be
+ambiguous. You have to use a qualified name. And there is no way to do
+this if both data types are declared in the same module.
+
+NB 2: The notation getField @"size" e is short for
+HsApp (HsAppType (HsVar "getField") (HsWC (HsTyLit (HsStrTy "size")) [])) e.
+We track the original parsed syntax via HsExpanded.
+
+-}
+
+{-
+Note [Non-overloaded record field selectors]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Consider
+ data T = MkT { x,y :: Int }
+ f r x = x + y r
+
+This parses with HsVar for x, y, r on the RHS of f. Later, the renamer
+recognises that y in the RHS of f is really a record selector, and
+changes it to a HsRecSel. In contrast x is locally bound, shadowing
+the record selector, and stays as an HsVar.
+
+The renamer adds the Name of the record selector into the XCFieldOcc
+extension field, The typechecker keeps HsRecSel as HsRecSel, and
+transforms the record-selector Name to an Id.
+-}
+
-- | A Haskell expression.
data HsExpr p
= HsVar (XVar p)
@@ -285,11 +334,10 @@ data HsExpr p
-- solving. See Note [Holes] in GHC.Tc.Types.Constraint.
- | HsRecFld (XRecFld p)
- (AmbiguousFieldOcc p) -- ^ Variable pointing to record selector
- -- The parser produces HsVars
- -- The renamer renames record-field selectors to HsRecFld
- -- The typechecker preserves HsRecFld
+ | HsRecSel (XRecSel p)
+ (FieldOcc p) -- ^ Variable pointing to record selector
+ -- See Note [Non-overloaded record field selectors] and
+ -- Note [Record selectors in the AST]
| HsOverLabel (XOverLabel p) FastString
-- ^ Overloaded label (Note [Overloaded labels] in GHC.OverloadedLabels)
@@ -334,7 +382,7 @@ data HsExpr p
-- NB Bracketed ops such as (+) come out as Vars.
-- NB Sadly, we need an expr for the operator in an OpApp/Section since
- -- the renamer may turn a HsVar into HsRecFld or HsUnboundVar
+ -- the renamer may turn a HsVar into HsRecSel or HsUnboundVar
| OpApp (XOpApp p)
(LHsExpr p) -- left operand
@@ -486,7 +534,7 @@ data HsExpr p
-- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnDot'
--
-- This case only arises when the OverloadedRecordDot langauge
- -- extension is enabled.
+ -- extension is enabled. See Note [Record Selectors in the AST].
| HsGetField {
gf_ext :: XGetField p
@@ -500,7 +548,7 @@ data HsExpr p
-- 'GHC.Parser.Annotation.AnnDot', 'GHC.Parser.Annotation.AnnCloseP'
--
-- This case only arises when the OverloadedRecordDot langauge
- -- extensions is enabled.
+ -- extensions is enabled. See Note [Record Selectors in the AST].
| HsProjection {
proj_ext :: XProjection p
diff --git a/compiler/Language/Haskell/Syntax/Extension.hs b/compiler/Language/Haskell/Syntax/Extension.hs
index 44695066d4..f414968a6e 100644
--- a/compiler/Language/Haskell/Syntax/Extension.hs
+++ b/compiler/Language/Haskell/Syntax/Extension.hs
@@ -385,7 +385,7 @@ type family XXInjectivityAnn x
type family XVar x
type family XUnboundVar x
-type family XRecFld x
+type family XRecSel x
type family XOverLabel x
type family XIPVar x
type family XOverLitE x
diff --git a/compiler/Language/Haskell/Syntax/Pat.hs b/compiler/Language/Haskell/Syntax/Pat.hs
index 051f7d8f72..c7829d833c 100644
--- a/compiler/Language/Haskell/Syntax/Pat.hs
+++ b/compiler/Language/Haskell/Syntax/Pat.hs
@@ -344,7 +344,7 @@ hsRecFieldsArgs :: forall p arg. UnXRec p => HsRecFields p arg -> [arg]
hsRecFieldsArgs rbinds = map (hfbRHS . unXRec @p) (rec_flds rbinds)
hsRecFieldSel :: forall p arg. UnXRec p => HsRecField p arg -> XCFieldOcc p
-hsRecFieldSel = extFieldOcc . unXRec @p . hfbLHS
+hsRecFieldSel = foExt . unXRec @p . hfbLHS
{-
diff --git a/compiler/Language/Haskell/Syntax/Type.hs b/compiler/Language/Haskell/Syntax/Type.hs
index 1b945c9c1e..1b311716d0 100644
--- a/compiler/Language/Haskell/Syntax/Type.hs
+++ b/compiler/Language/Haskell/Syntax/Type.hs
@@ -6,6 +6,7 @@
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UndecidableInstances #-} -- Wrinkle in Note [Trees That Grow]
-- in module Language.Haskell.Syntax.Extension
{-
@@ -1293,31 +1294,34 @@ type LFieldOcc pass = XRec pass (FieldOcc pass)
-- | Field Occurrence
--
--- Represents an *occurrence* of an unambiguous field. This may or may not be a
+-- Represents an *occurrence* of a field. This may or may not be a
-- binding occurrence (e.g. this type is used in 'ConDeclField' and
--- 'RecordPatSynField' which bind their fields, but also in 'HsRecField' for
--- record construction and patterns, which do not).
+-- 'RecordPatSynField' which bind their fields, but also in
+-- 'HsRecField' for record construction and patterns, which do not).
--
--- We store both the 'RdrName' the user originally wrote, and after the renamer,
--- the selector function.
-data FieldOcc pass = FieldOcc { extFieldOcc :: XCFieldOcc pass
- , rdrNameFieldOcc :: LocatedN RdrName
- -- ^ See Note [Located RdrNames] in "GHC.Hs.Expr"
- }
-
- | XFieldOcc
- !(XXFieldOcc pass)
-
-deriving instance (Eq (XCFieldOcc pass), Eq (XXFieldOcc pass)) => Eq (FieldOcc pass)
+-- We store both the 'RdrName' the user originally wrote, and after
+-- the renamer we use the extension field to store the selector
+-- function.
+data FieldOcc pass
+ = FieldOcc {
+ foExt :: XCFieldOcc pass
+ , foLabel :: XRec pass RdrName -- See Note [Located RdrNames] in Language.Haskell.Syntax.Expr
+ }
+ | XFieldOcc !(XXFieldOcc pass)
+deriving instance (
+ Eq (XRec pass RdrName)
+ , Eq (XCFieldOcc pass)
+ , Eq (XXFieldOcc pass)
+ ) => Eq (FieldOcc pass)
-instance Outputable (FieldOcc pass) where
- ppr = ppr . rdrNameFieldOcc
+instance Outputable (XRec pass RdrName) => Outputable (FieldOcc pass) where
+ ppr = ppr . foLabel
-instance OutputableBndr (FieldOcc pass) where
- pprInfixOcc = pprInfixOcc . unLoc . rdrNameFieldOcc
- pprPrefixOcc = pprPrefixOcc . unLoc . rdrNameFieldOcc
+instance (UnXRec pass, OutputableBndr (XRec pass RdrName)) => OutputableBndr (FieldOcc pass) where
+ pprInfixOcc = pprInfixOcc . unXRec @pass . foLabel
+ pprPrefixOcc = pprPrefixOcc . unXRec @pass . foLabel
-instance OutputableBndr (GenLocated SrcSpan (FieldOcc pass)) where
+instance (UnXRec pass, OutputableBndr (XRec pass RdrName)) => OutputableBndr (GenLocated SrcSpan (FieldOcc pass)) where
pprInfixOcc = pprInfixOcc . unLoc
pprPrefixOcc = pprPrefixOcc . unLoc
@@ -1333,9 +1337,8 @@ type LAmbiguousFieldOcc pass = XRec pass (AmbiguousFieldOcc pass)
-- (for unambiguous occurrences) or the typechecker (for ambiguous
-- occurrences).
--
--- See Note [HsRecField and HsRecUpdField] in "GHC.Hs.Pat" and
--- Note [Disambiguating record fields] in "GHC.Tc.Gen.Head".
--- See Note [Located RdrNames] in "GHC.Hs.Expr"
+-- See Note [HsRecField and HsRecUpdField] in "GHC.Hs.Pat".
+-- See Note [Located RdrNames] in "GHC.Hs.Expr".
data AmbiguousFieldOcc pass
= Unambiguous (XUnambiguous pass) (LocatedN RdrName)
| Ambiguous (XAmbiguous pass) (LocatedN RdrName)
diff --git a/testsuite/tests/backpack/should_compile/T13323.bkp b/testsuite/tests/backpack/should_compile/T13323.bkp
index 70a1ccf89c..a66eb39ef9 100644
--- a/testsuite/tests/backpack/should_compile/T13323.bkp
+++ b/testsuite/tests/backpack/should_compile/T13323.bkp
@@ -5,8 +5,6 @@ unit p where
data B = B { foo :: Bool }
module P where
import A
- x :: A -> Int
- x = foo
unit q where
module A where
data A = A { foo :: Int }
diff --git a/testsuite/tests/backpack/should_compile/T13323.stderr b/testsuite/tests/backpack/should_compile/T13323.stderr
index 7e637d9dd4..eb49bcbfab 100644
--- a/testsuite/tests/backpack/should_compile/T13323.stderr
+++ b/testsuite/tests/backpack/should_compile/T13323.stderr
@@ -1,11 +1,6 @@
[1 of 3] Processing p
[1 of 2] Compiling A[sig] ( p/A.hsig, nothing )
[2 of 2] Compiling P ( p/P.hs, nothing )
-
-T13323.bkp:9:13: warning: [-Wambiguous-fields (in -Wdefault)]
- The field ‘foo’ belonging to type A is ambiguous.
- This will not be supported by -XDuplicateRecordFields in future releases of GHC.
- You can use a qualified import or explicit case analysis to resolve the ambiguity.
[2 of 3] Processing q
Instantiating q
[1 of 1] Compiling A ( q/A.hs, T13323.out/q/A.o )
@@ -15,10 +10,5 @@ T13323.bkp:9:13: warning: [-Wambiguous-fields (in -Wdefault)]
Instantiating p[A=q:A]
[1 of 2] Compiling A[sig] ( p/A.hsig, T13323.out/p/p-HVmFlcYSefiK5n1aDP1v7x/A.o )
[2 of 2] Compiling P ( p/P.hs, T13323.out/p/p-HVmFlcYSefiK5n1aDP1v7x/P.o )
-
-T13323.bkp:9:13: warning: [-Wambiguous-fields (in -Wdefault)]
- The field ‘foo’ belonging to type A is ambiguous.
- This will not be supported by -XDuplicateRecordFields in future releases of GHC.
- You can use a qualified import or explicit case analysis to resolve the ambiguity.
[1 of 2] Compiling R ( r/R.hs, T13323.out/r/R.o )
[2 of 2] Instantiating p
diff --git a/testsuite/tests/overloadedrecflds/should_fail/DRFUnused.stderr b/testsuite/tests/overloadedrecflds/should_fail/DRFUnused.stderr
index 7e75f5c8c7..2043591329 100644
--- a/testsuite/tests/overloadedrecflds/should_fail/DRFUnused.stderr
+++ b/testsuite/tests/overloadedrecflds/should_fail/DRFUnused.stderr
@@ -1,8 +1,7 @@
-DRFUnused.hs:10:16: error: [-Wunused-top-binds (in -Wextra, -Wunused-binds), -Werror=unused-top-binds]
- Defined but not used: ‘foo’
-
-DRFUnused.hs:18:5: warning: [-Wambiguous-fields (in -Wdefault)]
- The field ‘foo’ belonging to type U is ambiguous.
- This will not be supported by -XDuplicateRecordFields in future releases of GHC.
- You can use explicit case analysis to resolve the ambiguity.
+DRFUnused.hs:18:5:
+ Ambiguous occurrence ‘foo’
+ It could refer to
+ either the field ‘foo’, defined at DRFUnused.hs:12:16
+ or the field ‘foo’, defined at DRFUnused.hs:11:16
+ or the field ‘foo’, defined at DRFUnused.hs:10:16
diff --git a/testsuite/tests/overloadedrecflds/should_fail/T11167_ambiguous_fixity.stderr b/testsuite/tests/overloadedrecflds/should_fail/T11167_ambiguous_fixity.stderr
index 2a107d6570..7dd2913739 100644
--- a/testsuite/tests/overloadedrecflds/should_fail/T11167_ambiguous_fixity.stderr
+++ b/testsuite/tests/overloadedrecflds/should_fail/T11167_ambiguous_fixity.stderr
@@ -2,15 +2,15 @@
[2 of 3] Compiling T11167_ambiguous_fixity_B ( T11167_ambiguous_fixity_B.hs, T11167_ambiguous_fixity_B.o )
[3 of 3] Compiling T11167_ambiguous_fixity ( T11167_ambiguous_fixity.hs, T11167_ambiguous_fixity.o )
-T11167_ambiguous_fixity.hs:6:7: error:
- Ambiguous fixity for record field ‘foo’
- Conflicts:
- infixr 3
- imported from ‘T11167_ambiguous_fixity_A’ at T11167_ambiguous_fixity.hs:3:1-32
- (and originally defined at T11167_ambiguous_fixity_A.hs:4:16-18)
- infixr 3
- imported from ‘T11167_ambiguous_fixity_A’ at T11167_ambiguous_fixity.hs:3:1-32
- (and originally defined at T11167_ambiguous_fixity_A.hs:3:16-18)
- infixl 5
- imported from ‘T11167_ambiguous_fixity_B’ at T11167_ambiguous_fixity.hs:4:1-32
- (and originally defined at T11167_ambiguous_fixity_B.hs:2:16-18)
+ T11167_ambiguous_fixity.hs:6:16:
+ Ambiguous occurrence ‘foo’
+ It could refer to
+ either the field ‘foo’,
+ imported from ‘T11167_ambiguous_fixity_A’ at T11167_ambiguous_fixity.hs:3:1-32
+ (and originally defined at T11167_ambiguous_fixity_A.hs:4:16-18)
+ or the field ‘foo’,
+ imported from ‘T11167_ambiguous_fixity_A’ at T11167_ambiguous_fixity.hs:3:1-32
+ (and originally defined at T11167_ambiguous_fixity_A.hs:3:16-18)
+ or the field ‘foo’,
+ imported from ‘T11167_ambiguous_fixity_B’ at T11167_ambiguous_fixity.hs:4:1-32
+ (and originally defined at T11167_ambiguous_fixity_B.hs:2:16-18)
diff --git a/testsuite/tests/overloadedrecflds/should_fail/T13132_duplicaterecflds.stderr b/testsuite/tests/overloadedrecflds/should_fail/T13132_duplicaterecflds.stderr
index 391ccde4c1..d43b70ce3f 100644
--- a/testsuite/tests/overloadedrecflds/should_fail/T13132_duplicaterecflds.stderr
+++ b/testsuite/tests/overloadedrecflds/should_fail/T13132_duplicaterecflds.stderr
@@ -1,6 +1,22 @@
-T13132_duplicaterecflds.hs:9:11: error:
+ T13132_duplicaterecflds.hs:7:16:
+ Ambiguous occurrence ‘runContT’
+ It could refer to
+ either the field ‘runContT’,
+ defined at T13132_duplicaterecflds.hs:5:33
+ or the field ‘runContT’,
+ defined at T13132_duplicaterecflds.hs:4:31
+
+T13132_duplicaterecflds.hs:9:11:
The operator ‘runContT’ [infixl 9] of a section
must have lower precedence than that of the operand,
namely ‘y’ [infixl 9]
in the section: ‘`runContT` x `y` x’
+
+ T13132_duplicaterecflds.hs:9:12:
+ Ambiguous occurrence ‘runContT’
+ It could refer to
+ either the field ‘runContT’,
+ defined at T13132_duplicaterecflds.hs:5:33
+ or the field ‘runContT’,
+ defined at T13132_duplicaterecflds.hs:4:31
diff --git a/testsuite/tests/overloadedrecflds/should_fail/all.T b/testsuite/tests/overloadedrecflds/should_fail/all.T
index 169d47813a..396ea516e8 100644
--- a/testsuite/tests/overloadedrecflds/should_fail/all.T
+++ b/testsuite/tests/overloadedrecflds/should_fail/all.T
@@ -47,3 +47,4 @@ test('NFSExport', normal, compile_fail, [''])
test('T18999_NoDisambiguateRecordFields', normal, compile_fail, [''])
test('DRFUnused', normal, compile_fail, [''])
test('T19287', normal, compile_fail, [''])
+test('overloadedrecfldswasrunnowfail06', normal, compile_fail, [''])
diff --git a/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail02.stderr b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail02.stderr
index 9c2057e17d..7591e8be6c 100644
--- a/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail02.stderr
+++ b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail02.stderr
@@ -1,6 +1,6 @@
overloadedrecfldsfail02.hs:8:18: error:
Ambiguous occurrence ‘x’
- It could refer to either the field ‘x’,
- defined at overloadedrecfldsfail02.hs:6:16
- or the field ‘x’, defined at overloadedrecfldsfail02.hs:5:16
+ It could refer to
+ either the field ‘x’, defined at overloadedrecfldsfail02.hs:6:16
+ or the field ‘x’, defined at overloadedrecfldsfail02.hs:5:16
diff --git a/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail04.stderr b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail04.stderr
index 0c58ad7164..6f5e7588f1 100644
--- a/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail04.stderr
+++ b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail04.stderr
@@ -1,11 +1,12 @@
[1 of 2] Compiling OverloadedRecFldsFail04_A ( OverloadedRecFldsFail04_A.hs, OverloadedRecFldsFail04_A.o )
[2 of 2] Compiling Main ( overloadedrecfldsfail04.hs, overloadedrecfldsfail04.o )
-overloadedrecfldsfail04.hs:9:6: error:
+ overloadedrecfldsfail04.hs:9:6:
Ambiguous occurrence ‘I.x’
- It could refer to either the field ‘x’,
- imported from ‘OverloadedRecFldsFail04_A’ at overloadedrecfldsfail04.hs:6:1-37
- (and originally defined at OverloadedRecFldsFail04_A.hs:6:16)
- or the field ‘x’,
- imported from ‘OverloadedRecFldsFail04_A’ at overloadedrecfldsfail04.hs:6:1-37
- (and originally defined at OverloadedRecFldsFail04_A.hs:5:16)
+ It could refer to
+ either the field ‘x’,
+ imported from ‘OverloadedRecFldsFail04_A’ at overloadedrecfldsfail04.hs:6:1-37
+ (and originally defined at OverloadedRecFldsFail04_A.hs:6:16)
+ or the field ‘x’,
+ imported from ‘OverloadedRecFldsFail04_A’ at overloadedrecfldsfail04.hs:6:1-37
+ (and originally defined at OverloadedRecFldsFail04_A.hs:5:16)
diff --git a/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail11.stderr b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail11.stderr
index a5cc4e8197..687af43de1 100644
--- a/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail11.stderr
+++ b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail11.stderr
@@ -1,12 +1,12 @@
[1 of 2] Compiling OverloadedRecFldsFail11_A ( OverloadedRecFldsFail11_A.hs, OverloadedRecFldsFail11_A.o )
[2 of 2] Compiling Main ( overloadedrecfldsfail11.hs, overloadedrecfldsfail11.o )
-overloadedrecfldsfail11.hs:5:15: error: [-Wambiguous-fields (in -Wdefault), -Werror=ambiguous-fields]
- The field ‘foo’ belonging to type S is ambiguous.
- This will not be supported by -XDuplicateRecordFields in future releases of GHC.
- You can use a qualified import or explicit case analysis to resolve the ambiguity.
-
-overloadedrecfldsfail11.hs:5:15: error: [-Wdeprecations (in -Wdefault), -Werror=deprecations]
- In the use of ‘foo’ (imported from OverloadedRecFldsFail11_A):
- "Warning on a record field"
-
+overloadedrecfldsfail11.hs:5:15:
+ Ambiguous occurrence ‘foo’
+ It could refer to
+ either the field ‘foo’,
+ imported from ‘OverloadedRecFldsFail11_A’ at overloadedrecfldsfail11.hs:3:1-32
+ (and originally defined at OverloadedRecFldsFail11_A.hs:6:16-18)
+ or the field ‘foo’,
+ imported from ‘OverloadedRecFldsFail11_A’ at overloadedrecfldsfail11.hs:3:1-32
+ (and originally defined at OverloadedRecFldsFail11_A.hs:5:16-18)
diff --git a/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail12.stderr b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail12.stderr
index be3d3d6f8d..b51fb80cca 100644
--- a/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail12.stderr
+++ b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail12.stderr
@@ -1,24 +1,18 @@
[1 of 2] Compiling OverloadedRecFldsFail12_A ( OverloadedRecFldsFail12_A.hs, OverloadedRecFldsFail12_A.o )
[2 of 2] Compiling Main ( overloadedrecfldsfail12.hs, overloadedrecfldsfail12.o )
-overloadedrecfldsfail12.hs:10:11: error: [-Wdeprecations (in -Wdefault), -Werror=deprecations]
- In the use of ‘foo’ (imported from OverloadedRecFldsFail12_A):
- "Deprecated foo"
+ overloadedrecfldsfail12.hs:13:5:
+ Ambiguous occurrence ‘foo’
+ It could refer to
+ either the field ‘foo’,
+ imported from ‘OverloadedRecFldsFail12_A’ at overloadedrecfldsfail12.hs:4:1-32
+ (and originally defined at OverloadedRecFldsFail12_A.hs:5:16-18)
+ or the field ‘foo’, defined at overloadedrecfldsfail12.hs:6:16
-overloadedrecfldsfail12.hs:10:20: error: [-Wdeprecations (in -Wdefault), -Werror=deprecations]
- In the use of ‘bar’ (imported from OverloadedRecFldsFail12_A):
- "Deprecated bar"
-
-overloadedrecfldsfail12.hs:13:5: error: [-Wambiguous-fields (in -Wdefault), -Werror=ambiguous-fields]
- The field ‘foo’ belonging to type T is ambiguous.
- This will not be supported by -XDuplicateRecordFields in future releases of GHC.
- You can use a qualified import or explicit case analysis to resolve the ambiguity.
-
-overloadedrecfldsfail12.hs:13:5: error: [-Wdeprecations (in -Wdefault), -Werror=deprecations]
- In the use of ‘foo’ (imported from OverloadedRecFldsFail12_A):
- "Deprecated foo"
-
-overloadedrecfldsfail12.hs:16:5: error: [-Wambiguous-fields (in -Wdefault), -Werror=ambiguous-fields]
- The field ‘foo’ belonging to type S is ambiguous.
- This will not be supported by -XDuplicateRecordFields in future releases of GHC.
- You can use explicit case analysis to resolve the ambiguity.
+ overloadedrecfldsfail12.hs:16:5:
+ Ambiguous occurrence ‘foo’
+ It could refer to
+ either the field ‘foo’,
+ imported from ‘OverloadedRecFldsFail12_A’ at overloadedrecfldsfail12.hs:4:1-32
+ (and originally defined at OverloadedRecFldsFail12_A.hs:5:16-18)
+ or the field ‘foo’, defined at overloadedrecfldsfail12.hs:6:16
diff --git a/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail13.stderr b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail13.stderr
index 7c61ab769e..ea8b6c4531 100644
--- a/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail13.stderr
+++ b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail13.stderr
@@ -1,22 +1,24 @@
-overloadedrecfldsfail13.hs:10:5: error:
- ‘x’ is not a (visible) field of type ‘U’
- In the expression: x (MkU :: U)
- In an equation for ‘a’: a = x (MkU :: U)
+ overloadedrecfldsfail13.hs:10:5:
+ Ambiguous occurrence ‘x’
+ It could refer to
+ either the field ‘x’, defined at overloadedrecfldsfail13.hs:7:16
+ or the field ‘x’, defined at overloadedrecfldsfail13.hs:6:16
-overloadedrecfldsfail13.hs:12:5: error:
+ overloadedrecfldsfail13.hs:12:5:
Ambiguous occurrence ‘x’
- It could refer to either the field ‘x’,
- defined at overloadedrecfldsfail13.hs:7:16
- or the field ‘x’, defined at overloadedrecfldsfail13.hs:6:16
+ It could refer to
+ either the field ‘x’, defined at overloadedrecfldsfail13.hs:7:16
+ or the field ‘x’, defined at overloadedrecfldsfail13.hs:6:16
-overloadedrecfldsfail13.hs:15:5: error:
- ‘x’ is not a (visible) field of type ‘U’
- In the expression: x
- In an equation for ‘c’: c = x
+ overloadedrecfldsfail13.hs:15:5:
+ Ambiguous occurrence ‘x’
+ It could refer to
+ either the field ‘x’, defined at overloadedrecfldsfail13.hs:7:16
+ or the field ‘x’, defined at overloadedrecfldsfail13.hs:6:16
-overloadedrecfldsfail13.hs:18:5: error:
+ overloadedrecfldsfail13.hs:18:5:
Ambiguous occurrence ‘x’
- It could refer to either the field ‘x’,
- defined at overloadedrecfldsfail13.hs:7:16
- or the field ‘x’, defined at overloadedrecfldsfail13.hs:6:16
+ It could refer to
+ either the field ‘x’, defined at overloadedrecfldsfail13.hs:7:16
+ or the field ‘x’, defined at overloadedrecfldsfail13.hs:6:16
diff --git a/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun06.hs b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldswasrunnowfail06.hs
index 92f870833d..92f870833d 100644
--- a/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun06.hs
+++ b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldswasrunnowfail06.hs
diff --git a/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldswasrunnowfail06.stderr b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldswasrunnowfail06.stderr
new file mode 100644
index 0000000000..de8cc1aadf
--- /dev/null
+++ b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldswasrunnowfail06.stderr
@@ -0,0 +1,40 @@
+
+ overloadedrecfldswasrunnowfail06.hs:11:11:
+ Ambiguous occurrence ‘x’
+ It could refer to
+ either the field ‘x’,
+ defined at overloadedrecfldswasrunnowfail06.hs:8:18
+ or the field ‘x’,
+ defined at overloadedrecfldswasrunnowfail06.hs:7:16
+ or the field ‘x’,
+ defined at overloadedrecfldswasrunnowfail06.hs:6:16
+
+ overloadedrecfldswasrunnowfail06.hs:13:11:
+ Ambiguous occurrence ‘x’
+ It could refer to
+ either the field ‘x’,
+ defined at overloadedrecfldswasrunnowfail06.hs:8:18
+ or the field ‘x’,
+ defined at overloadedrecfldswasrunnowfail06.hs:7:16
+ or the field ‘x’,
+ defined at overloadedrecfldswasrunnowfail06.hs:6:16
+
+ overloadedrecfldswasrunnowfail06.hs:15:13:
+ Ambiguous occurrence ‘x’
+ It could refer to
+ either the field ‘x’,
+ defined at overloadedrecfldswasrunnowfail06.hs:8:18
+ or the field ‘x’,
+ defined at overloadedrecfldswasrunnowfail06.hs:7:16
+ or the field ‘x’,
+ defined at overloadedrecfldswasrunnowfail06.hs:6:16
+
+ overloadedrecfldswasrunnowfail06.hs:21:20:
+ Ambiguous occurrence ‘x’
+ It could refer to
+ either the field ‘x’,
+ defined at overloadedrecfldswasrunnowfail06.hs:8:18
+ or the field ‘x’,
+ defined at overloadedrecfldswasrunnowfail06.hs:7:16
+ or the field ‘x’,
+ defined at overloadedrecfldswasrunnowfail06.hs:6:16
diff --git a/testsuite/tests/overloadedrecflds/should_run/all.T b/testsuite/tests/overloadedrecflds/should_run/all.T
index 4267c10d5e..8d6d9850bb 100644
--- a/testsuite/tests/overloadedrecflds/should_run/all.T
+++ b/testsuite/tests/overloadedrecflds/should_run/all.T
@@ -5,7 +5,6 @@ test('overloadedrecfldsrun02', [extra_files(['OverloadedRecFldsRun02_A.hs'])], m
test('overloadedrecfldsrun03', normal, compile_and_run, [''])
test('overloadedrecfldsrun04', omit_ways(prof_ways), compile_and_run, [''])
test('overloadedrecfldsrun05', normal, compile_and_run, [''])
-test('overloadedrecfldsrun06', normal, compile_and_run, [''])
test('overloadedrecfldsrun07', normal, compile_and_run, [''])
test('overloadedrecflds_generics', normal, compile_and_run, [''])
test('overloadedlabelsrun01', normal, compile_and_run, [''])
diff --git a/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun06.stdout b/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun06.stdout
deleted file mode 100644
index abc4e3b957..0000000000
--- a/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun06.stdout
+++ /dev/null
@@ -1,2 +0,0 @@
-42
-True
diff --git a/testsuite/tests/rename/should_compile/T11167_ambig.stderr b/testsuite/tests/rename/should_compile/T11167_ambig.stderr
deleted file mode 100644
index 5320b42149..0000000000
--- a/testsuite/tests/rename/should_compile/T11167_ambig.stderr
+++ /dev/null
@@ -1,11 +0,0 @@
-
-T11167_ambig.hs:10:13: warning: [-Wambiguous-fields (in -Wdefault)]
- The field ‘runContT’ belonging to type ContT r m a is ambiguous.
- This will not be supported by -XDuplicateRecordFields in future releases of GHC.
- You can use explicit case analysis to resolve the ambiguity.
-
-T11167_ambig.hs:17:9: warning: [-Wambiguous-fields (in -Wdefault)]
- The field ‘runContT’ belonging to type forall a.
- ContT () IO a is ambiguous.
- This will not be supported by -XDuplicateRecordFields in future releases of GHC.
- You can use explicit case analysis to resolve the ambiguity.
diff --git a/testsuite/tests/rename/should_compile/all.T b/testsuite/tests/rename/should_compile/all.T
index 92464ca55b..56521084d7 100644
--- a/testsuite/tests/rename/should_compile/all.T
+++ b/testsuite/tests/rename/should_compile/all.T
@@ -145,7 +145,6 @@ test('T9778', normal, compile, ['-fwarn-unticked-promoted-constructors'])
test('T10816', normal, compile, [''])
test('T11164', [], multimod_compile, ['T11164', '-v0'])
test('T11167', normal, compile, [''])
-test('T11167_ambig', normal, compile, [''])
test('T10625', normal, compile, [''])
test('T11624', [], multimod_compile, ['T11624', ''])
test('T11662', [], multimod_compile, ['T11662', '-v0'])
diff --git a/testsuite/tests/rename/should_compile/T11167_ambig.hs b/testsuite/tests/rename/should_fail/T11167_ambig.hs
index 74df05e5ee..74df05e5ee 100644
--- a/testsuite/tests/rename/should_compile/T11167_ambig.hs
+++ b/testsuite/tests/rename/should_fail/T11167_ambig.hs
diff --git a/testsuite/tests/rename/should_fail/T11167_ambig.stderr b/testsuite/tests/rename/should_fail/T11167_ambig.stderr
new file mode 100644
index 0000000000..bf1029b81d
--- /dev/null
+++ b/testsuite/tests/rename/should_fail/T11167_ambig.stderr
@@ -0,0 +1,12 @@
+
+ T11167_ambig.hs:10:13:
+ Ambiguous occurrence ‘runContT’
+ It could refer to
+ either the field ‘runContT’, defined at T11167_ambig.hs:7:32
+ or the field ‘runContT’, defined at T11167_ambig.hs:6:30
+
+ T11167_ambig.hs:17:9:
+ Ambiguous occurrence ‘runContT’
+ It could refer to
+ either the field ‘runContT’, defined at T11167_ambig.hs:7:32
+ or the field ‘runContT’, defined at T11167_ambig.hs:6:30
diff --git a/testsuite/tests/rename/should_fail/all.T b/testsuite/tests/rename/should_fail/all.T
index d709fd0ad0..c25a7c3d92 100644
--- a/testsuite/tests/rename/should_fail/all.T
+++ b/testsuite/tests/rename/should_fail/all.T
@@ -178,3 +178,4 @@ test('T19843j', normal, compile_fail, [''])
test('T19843k', normal, compile_fail, [''])
test('T19843l', normal, compile_fail, [''])
test('T19843m', normal, compile_fail, [''])
+test('T11167_ambig', normal, compile_fail, [''])
diff --git a/utils/check-exact/ExactPrint.hs b/utils/check-exact/ExactPrint.hs
index f63e9e61e1..8bcc508288 100644
--- a/utils/check-exact/ExactPrint.hs
+++ b/utils/check-exact/ExactPrint.hs
@@ -1780,7 +1780,7 @@ instance ExactPrint (GRHS GhcPs (LocatedA (HsCmd GhcPs))) where
instance ExactPrint (HsExpr GhcPs) where
getAnnotationEntry (HsVar{}) = NoEntryVal
getAnnotationEntry (HsUnboundVar an _) = fromAnn an
- getAnnotationEntry (HsRecFld{}) = NoEntryVal
+ getAnnotationEntry (HsRecSel{}) = NoEntryVal
getAnnotationEntry (HsOverLabel an _) = fromAnn an
getAnnotationEntry (HsIPVar an _) = fromAnn an
getAnnotationEntry (HsOverLit an _) = fromAnn an
@@ -1827,7 +1827,7 @@ instance ExactPrint (HsExpr GhcPs) where
printStringAtAA ob "`"
printStringAtAA l "_"
printStringAtAA cb "`"
- -- exact x@(HsRecFld{}) = withPpr x
+ -- exact x@(HsRecSel{}) = withPpr x
-- exact x@(HsOverLabel ann _ _) = withPpr x
exact (HsIPVar _ (HsIPName n))
= printStringAdvance ("?" ++ unpackFS n)
diff --git a/utils/haddock b/utils/haddock
-Subproject 3fe1ccd2393837c4e8bc788368c18b40f7dac91
+Subproject 3b6a8774bdb543dad59b2618458b07feab8a55e