Hannes Siebenhandl pushed to branch wip/fendor/has-field-hie at Glasgow Haskell Compiler / GHC Commits: b372f2b2 by fendor at 2026-09-16T10:52:33+02:00 WIP: Allow any Id as evidence - - - - - 8 changed files: - compiler/GHC/Iface/Ext/Ast.hs - + testsuite/tests/hiefile/should_run/HasFieldQueries.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/T23492.stdout - testsuite/tests/hiefile/should_run/all.T Changes: ===================================== compiler/GHC/Iface/Ext/Ast.hs ===================================== @@ -33,7 +33,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 ) 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(..) ) @@ -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))) ===================================== testsuite/tests/hiefile/should_run/HasFieldQueries.hs ===================================== @@ -0,0 +1,52 @@ +{-# LANGUAGE OverloadedRecordDot #-} +module Main where + +import TestUtils +import GHC.Records +import GHC.TypeLits +import Data.Tree + +data Thing = Thing {field1 :: Char, field2 :: Bool} + deriving (Show, Eq) + +foo :: Thing -> String +foo t = show t.field1 +-- ^ this is the point + +testing2 (x :: Thing) = x.field1 +-- ^ this is the point +-- ^ this is the point + +data NestedThing = NestedThing { nested1 :: Thing } + +nestedSig :: NestedThing -> Char +nestedSig n = n.nested1.field1 +-- ^ this is the point +-- ^ this is the point + +nestedNoSig n = n.nested1.field2 :: Bool +-- ^ this is the point +-- ^ this is the point + + +withConstraint :: HasField "field1" x Char => x -> Char +withConstraint x = x.field1 +-- ^ this is the point + +points = + [ (13,17) + , (16,25) + , (16,27) + , (23,17) + , (23,25) + , (27,20) + , (27,28) + , (33,22) + ] + +main = do + (df, hf) <- readTestHie "HasFieldQueries.hie" + let refmap = generateReferencesMap $ getAsts $ hie_asts hf + + traverse (explainEv df hf refmap) points + return () ===================================== testsuite/tests/hiefile/should_run/HasFieldQueries.stdout ===================================== @@ -0,0 +1,156 @@ +========================== +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, +│ 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 a usage of an external evidence variable + │ Defined at HasFieldQueries.hs:9:21 + └ + +========================== +At point (16,25), we found: +========================== +========================== +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, +│ 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 a usage of an external evidence variable + │ Defined at HasFieldQueries.hs:9:21 + └ + +========================== +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, +│ 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 a usage of an external evidence variable + │ Defined at HasFieldQueries.hs:20:34 + └ + +========================== +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, +│ 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 a usage of an external evidence variable + │ Defined at HasFieldQueries.hs:9:21 + └ + +========================== +At point (27,20), we found: +========================== +┌ +│ $dHasField at HasFieldQueries.hs:27:1-40, of type: HasField "nested1" r r +│ is an evidence variable bound by a let, depending on: [$dHasField] +│ with scope: LocalScope HasFieldQueries.hs:27:1-40 +│ bound at: HasFieldQueries.hs:27:1-40 +│ Defined at <no location info> +└ +| +`- ┌ + │ $dHasField at HasFieldQueries.hs:27:1-40, of type: HasField "nested1" r r + │ is an evidence variable bound by a type signature + │ with scope: LocalScope HasFieldQueries.hs:27:1-40 + │ bound at: HasFieldQueries.hs:27:1-40 + │ Defined at <no location info> + └ + +========================== +At point (27,28), we found: +========================== +┌ +│ $dHasField at HasFieldQueries.hs:27:1-40, of type: HasField "field2" r Bool +│ is an evidence variable bound by a let, depending on: [$dHasField] +│ with scope: LocalScope HasFieldQueries.hs:27:1-40 +│ bound at: HasFieldQueries.hs:27:1-40 +│ Defined at <no location info> +└ +| +`- ┌ + │ $dHasField at HasFieldQueries.hs:27:1-40, of type: HasField "field2" r Bool + │ is an evidence variable bound by a type signature + │ with scope: LocalScope HasFieldQueries.hs:27:1-40 + │ bound at: HasFieldQueries.hs:27:1-40 + │ Defined at <no location info> + └ + +========================== +At point (33,22), we found: +========================== +┌ +│ $dHasField at HasFieldQueries.hs:33:1-27, of type: HasField "field1" x Char +│ is an evidence variable bound by a let, depending on: [$dHasField] +│ with scope: LocalScope HasFieldQueries.hs:33:1-27 +│ bound at: HasFieldQueries.hs:33:1-27 +│ Defined at <no location info> +└ +| +`- ┌ + │ $dHasField at HasFieldQueries.hs:33:1-27, of type: HasField "field1" x Char + │ is an evidence variable bound by a HsWrapper + │ with scope: LocalScope HasFieldQueries.hs:33:1-27 + │ bound at: HasFieldQueries.hs:33:1-27 + │ Defined at <no location info> + └ + ===================================== 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,5 +1,5 @@ At (22,6), got type: MyRecord -At (22,20), got type: Integer +At (22,20), got type: MyRecord -> Integer At (22,25), got type: MyRecord -At (22,28), got type: String -At (22,29), got type: String \ No newline at end of file +At (22,28), got type: MyChild -> [Char] +At (22,29), got type: MyChild -> [Char] ===================================== testsuite/tests/hiefile/should_run/T23492.stdout ===================================== @@ -4,4 +4,4 @@ PartialFieldSelector At (18,7), got type: PartialFieldSelector -> Bool At (23,7), got type: PartialFieldSelector At (23,8), got type: PartialFieldSelector -At (23,9), got type: Bool +At (23,9), got type: PartialFieldSelector -> Bool ===================================== testsuite/tests/hiefile/should_run/all.T ===================================== @@ -10,3 +10,5 @@ test('T23120', [extra_run_opts('"' + config.libdir + '"'), extra_files(['TestUti test('T24544', [extra_run_opts('"' + config.libdir + '"'), extra_files(['TestUtils.hs'])], compile_and_run, ['-package ghc -fwrite-ide-info']) 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/-/commit/b372f2b20954ba10687ab473269f0cbc... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b372f2b20954ba10687ab473269f0cbc... 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