Hannes Siebenhandl pushed to branch wip/fendor/has-field-hie at Glasgow Haskell Compiler / GHC Commits: f1e31835 by fendor at 2026-09-16T15:31:55+02:00 Allow any `Id` to be used for HIE evidence HIE evidence is used to show how a constraint has been solved and allows users to go directly to the definition or introduction of a particular evidence variable. So far, we only looked at evidence introduced by type class variables, but some evidence terms refer to other variables as well, such as record selectors. Such evidence terms add additional details and source locations. For generated evidence, such as `HasField` evidence to support `-XRecordDotSyntax`, the type class evidence is lacking and doesn't give us any usable source span pointing to the actual record selector. See this example evidence: $dHasField_aLw = GHC.Internal.Records.C:HasField @GHC.Internal.Types.Symbol @GHC.Internal.Types.LiftedRep @GHC.Internal.Types.LiftedRep @"foo" @Foo @Int (foo `cast` (<Foo -> Int>_R :: (Foo -> Int) ~R# (Foo -> Int))) The free variables of this term are `{C:HasField, foo}`. `foo` is the record selector from the type `Foo` and is crucial to guide users how this evidence is constructed, as the evidence `HasField` is not helpful. During HIE generation, we now take any `Id` into account to provide additional source spans to point to user to the definition site of the record selector. As a direct consequence, this allows HLS to implement a limited form of `Goto Definition` for expressions of the form `x.foo`, where `x :: Foo`. Capturing more `Id`s for evidence may have some side effects that are somewhat tricky to predict, since the tests are quite lacking. - - - - - 5c3ce3fe by fendor at 2026-09-16T15:32:17+02:00 Add additional details to evidence bindings Evidence bindings can be all sorts of things, such as type class evidence, a record selector or other builtin constructs such as `Typeable`. - - - - - bb8f0d26 by fendor at 2026-09-16T15:32:23+02:00 Typeable test - - - - - 9 changed files: - + changelog.d/record-dot-evidence - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Iface/Ext/Types.hs - compiler/GHC/Iface/Ext/Utils.hs - testsuite/tests/hiefile/should_run/HasFieldQueries.stdout - + testsuite/tests/hiefile/should_run/HieTypeable.hs - + testsuite/tests/hiefile/should_run/HieTypeable.stdout - testsuite/tests/hiefile/should_run/RecordDotTypes.stdout - testsuite/tests/hiefile/should_run/all.T Changes: ===================================== changelog.d/record-dot-evidence ===================================== @@ -0,0 +1,12 @@ +section: compiler +synopsis: Record selector functions as evidence for `HasField` constraints during .hie file generation. +description: { + We record the record selector `foo` of an expression such as `f.foo` as evidence for + solving the constraint `HasField "foo" record ty`. + + This allows us to point to the definition source location of the record selector `foo`, allowing + users to jump to definition using the evidence variables. +} + +issues: #25418 +mrs: !16694 ===================================== compiler/GHC/Iface/Ext/Ast.hs ===================================== @@ -23,7 +23,6 @@ import GHC.Core.DataCon ( dataConWrapperType ) import GHC.Core.Type ( Type, ForAllTyFlag(..) ) import GHC.Core.TyCon ( TyCon, tyConClass_maybe ) import GHC.Core.InstEnv -import GHC.Core.Predicate ( isEvId ) import GHC.Hs import GHC.Hs.Syn.Type @@ -33,7 +32,7 @@ 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, isId, idDetails ) import GHC.Types.Name ( Name, nameSrcSpan, nameUnique, wiredInNameTyThing_maybe, getName ) import GHC.Types.Name.Env ( NameEnv, emptyNameEnv, extendNameEnv, lookupNameEnv ) import GHC.Types.Name.Reader ( RecFieldInfo(..), WithUserRdr(..) ) @@ -81,6 +80,7 @@ import Control.Applicative ( (<|>) ) import GHC.Types.TypeEnv ( TypeEnv ) import Control.Arrow ( second ) import Data.Traversable ( mapAccumR ) +import GHC.Types.Id.Info (IdDetails(..), recSelParentName) {- Note [Updating HieAst for changes in the GHC AST] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -682,7 +682,7 @@ instance ToHie (Context (Located (WithUserRdr Name))) where hieEvIdsOfTerm :: EvTerm -> [EvId] -- Returns only EvIds satisfying relevantEvId -hieEvIdsOfTerm = runFVSelectiveList isEvId . evTermFVs +hieEvIdsOfTerm = runFVSelectiveList isId . evTermFVs instance ToHie (EvBindContext (LocatedA TcEvBinds)) where toHie (EvBindContext sc sp (L span (EvBinds bs))) @@ -690,7 +690,7 @@ instance ToHie (EvBindContext (LocatedA TcEvBinds)) where where go evbind = do let evDeps = hieEvIdsOfTerm $ eb_rhs evbind - depNames = EvBindDeps $ map varName evDeps + depNames = EvBindDeps $ map classifyEvBindDep evDeps concatM $ [ toHie (C (EvidenceVarBind (EvLetBind depNames) (combineScopes sc (mkScope span)) sp) (L span $ eb_lhs evbind)) @@ -698,6 +698,12 @@ instance ToHie (EvBindContext (LocatedA TcEvBinds)) where ] toHie _ = pure [] +classifyEvBindDep :: EvId -> EvBindDep +classifyEvBindDep evId = + case idDetails evId of + RecSelId{sel_tycon} -> RecordField (varName evId) (recSelParentName sel_tycon) + _ -> EvidenceVar (varName evId) + instance ToHie (LocatedA HsWrapper) where toHie (L osp wrap) = case wrap of ===================================== compiler/GHC/Iface/Ext/Types.hs ===================================== @@ -598,17 +598,61 @@ instance Outputable EvVarSource where ppr (EvInstBind True cls) = text "bound due to a superclass of " <+> ppr cls ppr (EvLetBind deps) = text "bound by a let, depending on:" <+> ppr deps +data EvBindDep + = EvidenceVar Name + | RecordField Name Name + | TypeableEvidence Name + deriving (Eq, Ord) + +instance Outputable EvBindDep where + ppr = \ case + EvidenceVar n -> ppr n + RecordField sel parent -> ppr sel <+> text "of Record" <+> ppr parent + TypeableEvidence n -> ppr n <+> text "bound by Typeable" + +evBindDepName :: EvBindDep -> Name +evBindDepName = \ case + EvidenceVar n -> n + RecordField selector _record -> selector + TypeableEvidence n -> n + +evBindDepHieName :: EvBindDep -> HieName +evBindDepHieName = toHieName . evBindDepName + +instance Binary EvBindDep where + put_ bh = \ case + EvidenceVar n -> do + putByte bh 0 + put_ bh n + RecordField n sel -> do + putByte bh 1 + put_ bh n + put_ bh sel + TypeableEvidence n -> do + putByte bh 2 + put_ bh n + + get bh = + getByte bh >>= \ case + 0 -> EvidenceVar <$> get bh + 1 -> RecordField <$> get bh <*> get bh + 2 -> TypeableEvidence <$> get bh + t -> fail $ "EvBindDep: Unknown tag: " ++ show t + -- | Eq/Ord instances compare on the converted HieName, -- as non-exported names may have different uniques after -- a roundtrip -newtype EvBindDeps = EvBindDeps { getEvBindDeps :: [Name] } +newtype EvBindDeps = EvBindDeps { getEvBindDeps :: [EvBindDep] } deriving Outputable +evBindDepsNames :: EvBindDeps -> [Name] +evBindDepsNames = map evBindDepName . getEvBindDeps + instance Eq EvBindDeps where - (==) = coerce ((==) `on` map toHieName) + (==) = coerce ((==) `on` map evBindDepHieName) instance Ord EvBindDeps where - compare = coerce (compare `on` map toHieName) + compare = coerce (compare `on` map evBindDepHieName) instance Binary EvBindDeps where put_ bh (EvBindDeps xs) = put_ bh xs ===================================== compiler/GHC/Iface/Ext/Utils.hs ===================================== @@ -145,7 +145,7 @@ getEvidenceTree refmap var = go emptyNameSet var det <- S.toList $ identInfo dets case det of EvidenceVarBind src@(EvLetBind (getEvBindDeps -> xs)) scp spn -> - pure $ Just ((src,scp,spn),mapMaybe (go $ extendNameSet seen var) xs) + pure $ Just ((src,scp,spn),mapMaybe (go (extendNameSet seen var) . evBindDepName) xs) EvidenceVarBind src scp spn -> pure $ Just ((src,scp,spn),[]) _ -> pure Nothing pure $ Tree.Node (EvidenceInfo var sp typ (Just evdet)) children @@ -390,7 +390,7 @@ definedInAsts asts n = case nameSrcSpan n of getEvidenceBindDeps :: ContextInfo -> [Name] getEvidenceBindDeps (EvidenceVarBind (EvLetBind xs) _ _) = - getEvBindDeps xs + evBindDepsNames xs getEvidenceBindDeps _ = [] isEvidenceBind :: ContextInfo -> Bool ===================================== testsuite/tests/hiefile/should_run/HasFieldQueries.stdout ===================================== @@ -3,16 +3,23 @@ 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: [C:HasField, +│ field1 of Record Thing] │ 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' +| └ +| `- ┌ - │ C:HasField at HasFieldQueries.hs:1:1, of type: forall {k} (x :: k) r a. (r -> a) -> HasField x r a + │ field1 at HasFieldQueries.hs:1:1, of type: Thing -> Char │ is a usage of an external evidence variable - │ Defined in `GHC.Internal.Records' + │ Defined at HasFieldQueries.hs:9:21 └ ========================== @@ -23,16 +30,23 @@ 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: [C:HasField, +│ field1 of Record Thing] │ 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' +| └ +| `- ┌ - │ C:HasField at HasFieldQueries.hs:1:1, of type: forall {k} (x :: k) r a. (r -> a) -> HasField x r a + │ field1 at HasFieldQueries.hs:1:1, of type: Thing -> Char │ is a usage of an external evidence variable - │ Defined in `GHC.Internal.Records' + │ Defined at HasFieldQueries.hs:9:21 └ ========================== @@ -40,16 +54,23 @@ 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: [C:HasField, +│ nested1 of Record NestedThing] │ 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' +| └ +| `- ┌ - │ C:HasField at HasFieldQueries.hs:1:1, of type: forall {k} (x :: k) r a. (r -> a) -> HasField x r a + │ nested1 at HasFieldQueries.hs:1:1, of type: NestedThing -> Thing │ is a usage of an external evidence variable - │ Defined in `GHC.Internal.Records' + │ Defined at HasFieldQueries.hs:20:34 └ ========================== @@ -57,16 +78,23 @@ 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: [C:HasField, +│ field1 of Record Thing] │ 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' +| └ +| `- ┌ - │ C:HasField at HasFieldQueries.hs:1:1, of type: forall {k} (x :: k) r a. (r -> a) -> HasField x r a + │ field1 at HasFieldQueries.hs:1:1, of type: Thing -> Char │ is a usage of an external evidence variable - │ Defined in `GHC.Internal.Records' + │ Defined at HasFieldQueries.hs:9:21 └ ========================== ===================================== testsuite/tests/hiefile/should_run/HieTypeable.hs ===================================== @@ -0,0 +1,28 @@ +module Main where + +import Data.Dynamic +import Data.Typeable +import TestUtils + +data Thing = Thing {field1 :: Char, field2 :: Bool} + deriving (Show, Eq) + +castFromDynamic :: Dynamic -> Maybe Thing +castFromDynamic d = fromDynamic d + -- ^ this is the point + +rep :: Thing -> TypeRep +rep d = typeOf d + -- ^ this is the point + +points = + [ (11,21) + , (15,10) + ] + +main = do + (df, hf) <- readTestHie "HieTypeable.hie" + let refmap = generateReferencesMap $ getAsts $ hie_asts hf + + traverse (explainEv df hf refmap) points + return () ===================================== testsuite/tests/hiefile/should_run/HieTypeable.stdout ===================================== @@ -0,0 +1,30 @@ +========================== +At point (11,21), we found: +========================== +┌ +│ $dTypeable at HieTypeable.hs:1:1, of type: Typeable Thing +│ is an evidence variable bound by a let, depending on: [$dTypeable] +│ with scope: ModuleScope +│ +│ Defined at <no location info> +└ +| +`- ┌ + │ $dTypeable at HieTypeable.hs:1:1, of type: Typeable Thing + │ is an evidence variable bound by a let, depending on: [] + │ with scope: ModuleScope + │ + │ Defined at <no location info> + └ + +========================== +At point (15,10), we found: +========================== +┌ +│ $dTypeable at HieTypeable.hs:1:1, of type: Typeable Thing +│ is an evidence variable bound by a let, depending on: [] +│ with scope: ModuleScope +│ +│ Defined at <no location info> +└ + ===================================== testsuite/tests/hiefile/should_run/RecordDotTypes.stdout ===================================== @@ -1,9 +1,9 @@ At (22,6), got type: MyRecord At (22,20), got type: MyRecord -> Integer At (22,25), got type: MyRecord -At (22,28), got type: MyChild -> String -At (22,29), got type: MyChild -> String -At (22,6) - (22,8), got type: String +At (22,28), got type: MyChild -> [Char] +At (22,29), got type: MyChild -> [Char] +At (22,6) - (22,8), got type: [Char] At (22,17) - (22,20), got type: Integer At (22,25) - (22,27), got type: MyChild -At (22,25) - (22,29), got type: String +At (22,25) - (22,29), got type: [Char] ===================================== testsuite/tests/hiefile/should_run/all.T ===================================== @@ -11,3 +11,4 @@ test('T24544', [extra_run_opts('"' + config.libdir + '"'), extra_files(['TestUti test('HieGadtConSigs', [extra_run_opts('"' + config.libdir + '"'), extra_files(['TestUtils.hs'])], compile_and_run, ['-package ghc -fwrite-ide-info']) test('T25709', [extra_run_opts('"' + config.libdir + '"'), extra_files(['TestUtils.hs'])], compile_and_run, ['-package ghc -fwrite-ide-info']) test('HasFieldQueries', [extra_run_opts('"' + config.libdir + '"'), extra_files(['TestUtils.hs'])], compile_and_run, ['-package ghc -fwrite-ide-info']) +test('HieTypeable', [extra_run_opts('"' + config.libdir + '"'), extra_files(['TestUtils.hs'])], compile_and_run, ['-package ghc -fwrite-ide-info']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1793ebd827282dcd8e6900e798cca04... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1793ebd827282dcd8e6900e798cca04... 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
participants (1)
-
Hannes Siebenhandl (@fendor)