Hannes Siebenhandl pushed to branch wip/fendor/has-field-hie at Glasgow Haskell Compiler / GHC Commits: 7514547d by Your Name at 2026-09-02T11:44:05+00:00 Give each getField in a projection section its field label's SrcSpan Co-Authored-By: Claude Opus 5 <noreply@anthropic.com> - - - - - 68ec7739 by Your Name at 2026-09-02T11:45:30+00:00 hie: report record selectors, not class dictionary constructors, as evidence Co-Authored-By: Claude Opus 5 <noreply@anthropic.com> - - - - - aec841af by fendor at 2026-09-02T14:47:06+02:00 Add regression test for record dot err ctx - - - - - 7 changed files: - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Rename/Expr.hs - testsuite/tests/hiefile/should_run/HasFieldQueries.hs - testsuite/tests/hiefile/should_run/HasFieldQueries.stdout - + testsuite/tests/overloadedrecflds/should_fail/RecordDotErrCtxt.hs - + testsuite/tests/overloadedrecflds/should_fail/RecordDotErrCtxt.stderr - testsuite/tests/overloadedrecflds/should_fail/all.T Changes: ===================================== compiler/GHC/Iface/Ext/Ast.hs ===================================== @@ -22,11 +22,11 @@ import GHC.Core.Utils (exprType) import GHC.Core.TyCo.Rep (Type(TyConApp)) import GHC.Core.TyCon (TyCon(..)) import GHC.Core.ConLike ( conLikeName ) -import GHC.Core.DataCon ( dataConWrapperType ) +import GHC.Core.DataCon ( dataConWrapperType, dataConTyCon ) import GHC.Core.Type ( Type, ForAllTyFlag(..) ) -import GHC.Core.TyCon ( TyCon, tyConClass_maybe ) +import GHC.Core.TyCon ( TyCon, tyConClass_maybe, isClassTyCon ) import GHC.Core.InstEnv -import GHC.Core.Predicate ( isEvId ) +import GHC.Core.Predicate ( isEvId, getClassPredTys_maybe ) import GHC.Hs import GHC.Hs.Syn.Type @@ -36,12 +36,12 @@ import GHC.Types.Basic import GHC.Types.UnresolvedImport ( isGeneratedImport ) import GHC.Types.FieldLabel import GHC.Types.Avail ( Avails ) -import GHC.Types.Id ( isDataConId_maybe ) +import GHC.Types.Id ( isDataConId_maybe, isRecordSelector ) import GHC.Types.Name ( Name, nameSrcSpan, nameUnique, wiredInNameTyThing_maybe, getName, hasKnownKey ) import GHC.Types.Name.Env ( NameEnv, emptyNameEnv, extendNameEnv, lookupNameEnv ) import GHC.Types.Name.Reader ( RecFieldInfo(..), WithUserRdr(..) ) import GHC.Types.SrcLoc -import GHC.Types.Var ( Id, Var, EvId, varName, varType, varUnique ) +import GHC.Types.Var ( Id, Var, EvId, varName, varType, varUnique, isId ) import GHC.Types.Var.Env import GHC.Types.Var.FV @@ -684,9 +684,73 @@ instance ToHie (Context (Located Name)) where instance ToHie (Context (Located (WithUserRdr Name))) where toHie (C c (L l (WithUserRdr _ n))) = toHie $ C c (L l n) -hieEvIdsOfTerm :: EvTerm -> [EvId] --- Returns only EvIds satisfying relevantEvId -hieEvIdsOfTerm = runFVSelectiveList isEvId . evTermFVs +{- Note [Evidence dependencies in HIE files] + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The 'EvBindDeps' of an 'EvLetBind' record what a dictionary was built out of, +so that a tool can answer "where does the evidence for this constraint come +from?" by walking 'getEvidenceTree' (in GHC.Iface.Ext.Utils). For that to be +useful, the dependencies have to /discriminate/ one solution from another. So +we make two adjustments to the plain free evidence variables of the right hand +side: + +(1) We drop the data constructor of a class dictionary, e.g. @C:HasField@. + These do satisfy 'isEvId', but they /construct/ a dictionary rather than + being evidence in their own right, and which one appears is already + determined by the constraint being solved. Reporting one tells a user + nothing they did not know from the constraint they hovered over, and is + actively misleading: it points into the module defining the /class/, + rather than at whatever provided the instance. + +(2) We keep record selectors, which are not evidence and so do not satisfy + 'isEvId'. When a constraint is solved by a built-in rule that builds the + dictionary out of a record selector instead of applying a dictionary + function, that selector plays exactly the role the dictionary function + would, and is the only thing recording /which/ instance was used. Such a + selector is additionally recorded as an 'EvInstBind' for the constraint's + own class, so that 'getEvidenceTree' describes it as providing the + instance instead of falling through to its "external evidence variable" + case (which is what it reports for a dependency it can find no evidence + binding for). + +@HasField@ is what motivates both rules: a constraint @HasField "fld" T Int@ +for a real record field is solved by building @MkHasField (fld |> co)@ -- see +Note [HasField instances] in GHC.Tc.Instance.Class -- so without (1) and (2) +the evidence for every record selection, however different, bottomed out at +@GHC.Internal.Records.C:HasField@. Neither rule names @HasField@, though, and +neither should: they say "a dictionary constructor explains nothing" and "a +selector used as evidence explains something", which holds for any class +solved this way. + +The 'EvInstBind' of (2) is deliberately recorded at the span of the /evidence +binding/, not at the selector's own 'nameSrcSpan'. Attaching an evidence +context to the field's declaration would merge it into the +'IdentifierDetails' of the declaration itself, and consumers reasonably skip +identifiers mentioning evidence when deciding what a source token refers to -- +Haddock's hyperlinked source would then stop linking the field declaration. +The 'Name' recorded is the selector either way, which is what an IDE needs in +order to navigate to it. +-} + +-- | Is this the data constructor of a class dictionary, e.g. @C:HasField@? +-- +-- See Note [Evidence dependencies in HIE files] +isClassDataConId :: Id -> Bool +isClassDataConId v + | Just dc <- isDataConId_maybe v = isClassTyCon (dataConTyCon dc) + | otherwise = False + +hieEvIdsOfTerm :: EvTerm -> [Var] +-- See Note [Evidence dependencies in HIE files] +hieEvIdsOfTerm = runFVSelectiveList relevant . evTermFVs + where + -- NB: this traversal offers us TyVars as well as Ids, and 'idDetails' + -- panics on a TyVar, so the Id-only predicates must be guarded by + -- 'isId'. 'isEvId' only looks at the type and is safe on either; it + -- deliberately admits coercion variables, which are TyVars. + relevant v + | not (isId v) = isEvId v + | otherwise = (isEvId v && not (isClassDataConId v)) + || isRecordSelector v instance ToHie (EvBindContext (LocatedA TcEvBinds)) where toHie (EvBindContext sc sp (L span (EvBinds bs))) @@ -699,6 +763,13 @@ instance ToHie (EvBindContext (LocatedA TcEvBinds)) where [ toHie (C (EvidenceVarBind (EvLetBind depNames) (combineScopes sc (mkScope span)) sp) (L span $ eb_lhs evbind)) , toHie $ map (C EvidenceVarUse . L span) $ evDeps + -- See Note [Evidence dependencies in HIE files] + , toHie [ C (EvidenceVarBind (EvInstBind False (className cls)) + ModuleScope Nothing) + (L span sel) + | Just (cls, _) <- [getClassPredTys_maybe (varType (eb_lhs evbind))] + , sel <- evDeps + , isId sel, isRecordSelector sel ] ] toHie _ = pure [] ===================================== compiler/GHC/Rename/Expr.hs ===================================== @@ -431,7 +431,7 @@ rnExpr (HsProjection _ fs) ; let fs' = NE.map rnDotFieldOcc fs ; return ( mkExpandedExpr (HsProjection noExtField fs') - (mkProjection getField circ $ NE.map (unLoc . dfoLabel) fs') + (mkProjection getField circ $ NE.map dfoLabel fs') , unitFN circ `plusFN` fv_getField) } ------------------------------------------ @@ -2916,14 +2916,24 @@ mkSet set_field acc (field, g) = wrapGenSpan (mkSetField set_field g field acc) -- mkProjection fields calculates a projection. -- e.g. .x = mkProjection [x] = getField @"x" -- .x.y = mkProjection [.x, .y] = (.y) . (.x) = getField @"y" . getField @"x" -mkProjection :: Name -> Name -> NonEmpty FieldLabelString -> HsExpr GhcRn -mkProjection getFieldName circName (field :| fields) = foldl' f (proj field) fields +mkProjection :: Name -> Name -> NonEmpty (XRec GhcRn FieldLabelString) + -> HsExpr GhcRn +mkProjection getFieldName circName (field :| fields) + = unLoc $ foldl' f (proj field) fields where - f :: HsExpr GhcRn -> FieldLabelString -> HsExpr GhcRn - f acc field = genHsApps circName $ map wrapGenSpan [proj field, acc] - - proj :: FieldLabelString -> HsExpr GhcRn - proj (FieldLabelString f) = genHsVar getFieldName `genAppType` genHsTyLit f + f :: LHsExpr GhcRn -> XRec GhcRn FieldLabelString -> LHsExpr GhcRn + f acc field = wrapGenSpan $ genHsApps circName [proj field, acc] + + -- Give each `getField` the SrcSpan of the label it projects, so that the + -- HasField evidence for that label can be found at the label itself. + -- Without this a multi-label section like (.x.y) has no usable span + -- anywhere inside it, and the whole section shows no type and no + -- evidence at all. + -- See Note [Source locations for implicit function calls] in GHC.Iface.Ext.Ast + proj :: XRec GhcRn FieldLabelString -> LHsExpr GhcRn + proj lfield@(L _ (FieldLabelString f)) + = wrapGenSpan' (getHasLoc lfield) + $ genHsVar getFieldName `genAppType` genHsTyLit f -- mkProjUpdateSetField calculates functions representing dot notation record updates. -- e.g. Suppose an update like foo.bar = 1. ===================================== testsuite/tests/hiefile/should_run/HasFieldQueries.hs ===================================== @@ -29,6 +29,16 @@ nestedNoSig n = n.nested1.field2 :: Bool -- ^ this is the point +-- Multi-label projection sections: each getField gets the SrcSpan of its own +-- field label, so both HasField dictionaries are reachable. Before that, no +-- node inside the section had a usable span and hovering it found nothing at +-- all. The points below are on 'nested1' and 'field1' respectively. +projSection :: NestedThing -> Char +projSection = (.nested1.field1) + +projSectionApplied :: NestedThing -> Char +projSectionApplied n = (.nested1.field1) n + points = [ (13,17) @@ -38,6 +48,10 @@ points = , (23,25) , (27,20) , (27,28) + , (37,17) + , (37,25) + , (40,26) + , (40,34) ] main = do ===================================== testsuite/tests/hiefile/should_run/HasFieldQueries.stdout ===================================== @@ -3,16 +3,18 @@ At point (13,17), we found: ========================== ┌ │ $dHasField at HasFieldQueries.hs:1:1, of type: HasField "field1" Thing Char -│ is an evidence variable bound by a let, depending on: [C:HasField] +│ is an evidence variable bound by a let, depending on: [field1] │ with scope: ModuleScope │ │ Defined at <no location info> └ | `- ┌ - │ C:HasField at HasFieldQueries.hs:1:1, of type: forall {k} (x :: k) r a. (r -> a) -> HasField x r a - │ is a usage of an external evidence variable - │ Defined in `GHC.Internal.Records' + │ field1 at HasFieldQueries.hs:1:1, of type: Thing -> Char + │ is an evidence variable bound by an instance of class HasField + │ with scope: ModuleScope + │ + │ Defined at HasFieldQueries.hs:9:21 └ ========================== @@ -23,16 +25,18 @@ At point (16,27), we found: ========================== ┌ │ $dHasField at HasFieldQueries.hs:16:1-32, of type: HasField "field1" Thing Char -│ is an evidence variable bound by a let, depending on: [C:HasField] +│ is an evidence variable bound by a let, depending on: [field1] │ with scope: LocalScope HasFieldQueries.hs:16:1-32 │ bound at: HasFieldQueries.hs:16:1-32 │ Defined at <no location info> └ | `- ┌ - │ C:HasField at HasFieldQueries.hs:1:1, of type: forall {k} (x :: k) r a. (r -> a) -> HasField x r a - │ is a usage of an external evidence variable - │ Defined in `GHC.Internal.Records' + │ field1 at HasFieldQueries.hs:1:1, of type: Thing -> Char + │ is an evidence variable bound by an instance of class HasField + │ with scope: ModuleScope + │ + │ Defined at HasFieldQueries.hs:9:21 └ ========================== @@ -40,16 +44,18 @@ At point (23,17), we found: ========================== ┌ │ $dHasField at HasFieldQueries.hs:1:1, of type: HasField "nested1" NestedThing Thing -│ is an evidence variable bound by a let, depending on: [C:HasField] +│ is an evidence variable bound by a let, depending on: [nested1] │ with scope: ModuleScope │ │ Defined at <no location info> └ | `- ┌ - │ C:HasField at HasFieldQueries.hs:1:1, of type: forall {k} (x :: k) r a. (r -> a) -> HasField x r a - │ is a usage of an external evidence variable - │ Defined in `GHC.Internal.Records' + │ nested1 at HasFieldQueries.hs:1:1, of type: NestedThing -> Thing + │ is an evidence variable bound by an instance of class HasField + │ with scope: ModuleScope + │ + │ Defined at HasFieldQueries.hs:20:34 └ ========================== @@ -57,17 +63,27 @@ At point (23,25), we found: ========================== ┌ │ $dHasField at HasFieldQueries.hs:1:1, of type: HasField "field1" Thing Char -│ is an evidence variable bound by a let, depending on: [C:HasField] +│ is an evidence variable bound by a let, depending on: [$dHasField] │ with scope: ModuleScope │ │ Defined at <no location info> └ | `- ┌ - │ C:HasField at HasFieldQueries.hs:1:1, of type: forall {k} (x :: k) r a. (r -> a) -> HasField x r a - │ is a usage of an external evidence variable - │ Defined in `GHC.Internal.Records' + │ $dHasField at HasFieldQueries.hs:1:1, of type: HasField "field1" Thing Char + │ is an evidence variable bound by a let, depending on: [field1] + │ with scope: ModuleScope + │ + │ Defined at <no location info> └ + | + `- ┌ + │ field1 at HasFieldQueries.hs:1:1, of type: Thing -> Char + │ is an evidence variable bound by an instance of class HasField + │ with scope: ModuleScope + │ + │ Defined at HasFieldQueries.hs:9:21 + └ ========================== At point (27,20), we found: @@ -107,3 +123,87 @@ At point (27,28), we found: │ Defined at <no location info> └ +========================== +At point (37,17), we found: +========================== +┌ +│ $dHasField at HasFieldQueries.hs:1:1, of type: HasField "nested1" NestedThing Thing +│ is an evidence variable bound by a let, depending on: [nested1] +│ with scope: ModuleScope +│ +│ Defined at <no location info> +└ +| +`- ┌ + │ nested1 at HasFieldQueries.hs:1:1, of type: NestedThing -> Thing + │ is an evidence variable bound by an instance of class HasField + │ with scope: ModuleScope + │ + │ Defined at HasFieldQueries.hs:20:34 + └ + +========================== +At point (37,25), we found: +========================== +┌ +│ $dHasField at HasFieldQueries.hs:1:1, of type: HasField "field1" Thing Char +│ is an evidence variable bound by a let, depending on: [$dHasField] +│ with scope: ModuleScope +│ +│ Defined at <no location info> +└ +| +`- ┌ + │ $dHasField at HasFieldQueries.hs:1:1, of type: HasField "field1" Thing Char + │ is an evidence variable bound by a let, depending on: [field1] + │ with scope: ModuleScope + │ + │ Defined at <no location info> + └ + | + `- ┌ + │ field1 at HasFieldQueries.hs:1:1, of type: Thing -> Char + │ is an evidence variable bound by an instance of class HasField + │ with scope: ModuleScope + │ + │ Defined at HasFieldQueries.hs:9:21 + └ + +========================== +At point (40,26), we found: +========================== +┌ +│ $dHasField at HasFieldQueries.hs:1:1, of type: HasField "nested1" NestedThing Thing +│ is an evidence variable bound by a let, depending on: [nested1] +│ with scope: ModuleScope +│ +│ Defined at <no location info> +└ +| +`- ┌ + │ nested1 at HasFieldQueries.hs:1:1, of type: NestedThing -> Thing + │ is an evidence variable bound by an instance of class HasField + │ with scope: ModuleScope + │ + │ Defined at HasFieldQueries.hs:20:34 + └ + +========================== +At point (40,34), we found: +========================== +┌ +│ $dHasField at HasFieldQueries.hs:1:1, of type: HasField "field1" Thing Char +│ is an evidence variable bound by a let, depending on: [field1] +│ with scope: ModuleScope +│ +│ Defined at <no location info> +└ +| +`- ┌ + │ field1 at HasFieldQueries.hs:1:1, of type: Thing -> Char + │ is an evidence variable bound by an instance of class HasField + │ with scope: ModuleScope + │ + │ Defined at HasFieldQueries.hs:9:21 + └ + ===================================== testsuite/tests/overloadedrecflds/should_fail/RecordDotErrCtxt.hs ===================================== @@ -0,0 +1,26 @@ +{-# LANGUAGE OverloadedRecordDot #-} + +-- The renamer expands @e.fld@ to @getField \@"fld" e@ (mkGetField in +-- GHC.Rename.Expr). For the sake of .hie files the application head of that +-- expansion carries the SrcSpan of the field label, but it must be a +-- *generated* span (@GeneratedSrcSpan (OrigSpan ...)@, built by wrapGenSpan') +-- rather than a plain RealSrcSpan, or else isGeneratedSrcSpan is False and +-- GHC.Tc.Gen.App starts reporting the internal 'getField' to the user. +-- +-- The CtOrigin site (mk_origin) is already covered by T26480b, which contrasts +-- an explicit 'getField' ("arising from a use of `getField'") with record dot +-- syntax ("arising from selecting the field `x'"); see also T19843h and +-- RecordDotSyntaxFail8. The result-type site is covered by +-- RecordDotSyntaxFail9. +-- +-- What is *not* covered anywhere else is addArgCtxt (GHC.Tc.Gen.App), which +-- needs an ill-typed argument underneath the selection. With a real head span +-- the second error below would gain a +-- "In the first argument of `getField', namely `('c' + 1)'" +-- context line. +module RecordDotErrCtxt where + +data T = MkT { fld :: Int } + +argCtxt :: Int +argCtxt = ('c' + 1).fld ===================================== testsuite/tests/overloadedrecflds/should_fail/RecordDotErrCtxt.stderr ===================================== @@ -0,0 +1,13 @@ +RecordDotErrCtxt.hs:26:11: error: [GHC-39999] + • No instance for ‘GHC.Internal.Records.HasField "fld" Char Int’ + arising from selecting the field ‘fld’ + NB: ‘Char’ is not a record type. + • In the expression: ('c' + 1).fld + In an equation for ‘argCtxt’: argCtxt = ('c' + 1).fld + +RecordDotErrCtxt.hs:26:16: error: [GHC-39999] + • No instance for ‘Num Char’ arising from a use of ‘+’ + • In the expression: 'c' + 1 + In the expression: ('c' + 1).fld + In an equation for ‘argCtxt’: argCtxt = ('c' + 1).fld + ===================================== testsuite/tests/overloadedrecflds/should_fail/all.T ===================================== @@ -63,3 +63,4 @@ test('T23010_fail', [extra_files(['T23010_fail.hs-boot', 'T23010_fail_aux.hs'])] , multimod_compile_fail , ['T23010_fail T23010_fail_aux', '-v0']) test('T23063', extra_files(['T23063_aux.hs']), multimod_compile_fail, ['T23063', '-v0']) +test('RecordDotErrCtxt', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0c64437518c798a293e4189acc0fd7d... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0c64437518c798a293e4189acc0fd7d... You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help