Hannes Siebenhandl pushed to branch wip/fendor/has-field-hie at Glasgow Haskell Compiler / GHC Commits: fabdfe82 by fendor at 2026-09-17T11:29:46+02:00 Add more .hie file tests for OverloadedRecordDot Add 'selectRange' function to get the type of a selection. - - - - - 0ec259eb by fendor at 2026-09-17T11:32:11+02:00 Record `FieldLabel` source span in AST node We attach evidence variables based on the source span of the concrete AST node in the HIE file. The evidence for the `HasField` constraint has the source span of the field selector, e.g. the AST node that gave rise to the `HasField` constraint. Since the AST node doesn't show up in the HIE file, the evidence for `HasField` was also not recorded for the span. Thus, `getEvidenceTree` wouldn't even list `HasField` as evidence, even in the perfectly normal case of: baz :: HasField "foo" f Int => f -> Int baz f = f.foo Requesting the evidence tree for `.foo` should point to the definition of `baz`, but since we omitted the source span for the field selector `.foo` from the AST node, the HIE file doesn't list it as evidence. By using the source spans of the individual field selectors, there are two consequences: * We can see the `HasField` evidence for record dot syntax at the field selector span * The reported type of `.foo` is `Foo -> Int` instead of just `Int` The latter is a change of behaviour that is unfortunate but the right behaviour, since there is now a source span for the whole expression `x.foo`, one for `x` and one for the selector `.foo`. If you query for the type at span `x.foo`, then the correct type `Int` is shown, but in downstream tooling (such as HLS), such requests are not possible in LSP. Thus, the behaviour changes. - - - - - ce94ad34 by fendor at 2026-09-17T11:33:19+02:00 Typeable test - - - - - 15 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 - compiler/GHC/Rename/Expr.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/NoFieldSelectorQueries.hs - + testsuite/tests/hiefile/should_run/NoFieldSelectorQueries.stdout - testsuite/tests/hiefile/should_run/RecordDotTypes.hs - testsuite/tests/hiefile/should_run/RecordDotTypes.stdout - testsuite/tests/hiefile/should_run/T23492.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,79 @@ 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 +-- | Evidence binding dependency with additional details. +data EvBindDep + = EvidenceVar Name + -- ^ Evidence variable such as a type class constructor. + -- + -- For example, @C:HasField@, @$dShow@ (dictionaries) or @$fCList@. + -- + -- This is the default representation of a 'EvBindDep'. + | RecordField + -- ^ Evidence variable of a record selector. + -- + -- This is for example generated with @-XOverloadedRecordDot@, where + -- the evidence includes a reference to which record selector is used + -- to implement @getField@. + Name + -- ^ 'Name' of the record selector + Name + -- ^ 'Name' of the parent type. + | TypeableEvidence + -- ^ Evidence of a @Typeable@ constraint. + Name + -- ^ Name of the type the evidence was generated for. + 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 ===================================== @@ -82,15 +82,19 @@ resolveVisibility kind ty_args foldType :: (HieType a -> a) -> HieTypeFix -> a foldType f (Roll t) = f $ fmap (foldType f) t -selectPoint :: HieFile -> (Int,Int) -> Maybe (HieAST Int) -selectPoint hf (sl,sc) = getFirst $ +selectPoint :: HieFile -> (Int,Int) -> Maybe (HieAST TypeIndex) +selectPoint hf p = selectRange hf p p + +selectRange :: HieFile -> (Int,Int) -> (Int,Int) -> Maybe (HieAST TypeIndex) +selectRange hf (sl,sc) (el, ec) = getFirst $ flip foldMap (M.toList (getAsts $ hie_asts hf)) $ \(HiePath fs,ast) -> First $ case selectSmallestContaining (sp fs) ast of Nothing -> Nothing Just ast' -> Just ast' where sloc fs = mkRealSrcLoc fs sl sc - sp fs = mkRealSrcSpan (sloc fs) (sloc fs) + eloc fs = mkRealSrcLoc fs el ec + sp fs = mkRealSrcSpan (sloc fs) (eloc fs) findEvidenceUse :: NodeIdentifiers a -> [Name] findEvidenceUse ni = [n | (Right n, dets) <- xs, any isEvidenceUse (identInfo dets)] @@ -141,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 @@ -386,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 ===================================== compiler/GHC/Rename/Expr.hs ===================================== @@ -422,7 +422,7 @@ rnExpr (HsGetField _ e f) ; let f' = rnDotFieldOcc <$> f ; return ( mkExpandedExpr (HsGetField noExtField e f') - (mkGetField getField e (fmap (unLoc . dfoLabel) f')) + (mkGetField getField e (dfoLabel $ unLoc f')) , fv_e `plusFN` fv_getField ) } rnExpr (HsProjection _ fs) @@ -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) } ------------------------------------------ @@ -2882,8 +2882,9 @@ rnHsIf p b1 b2 -- mkGetField arg field calculates a get_field @field arg expression. -- e.g. z.x = mkGetField z x = get_field @x z -mkGetField :: Name -> LHsExpr GhcRn -> LocatedAn NoEpAnns FieldLabelString -> HsExpr GhcRn -mkGetField get_field arg field = unLoc (head $ mkGet get_field (arg :| []) field) +mkGetField :: Name -> LHsExpr GhcRn -> XRec GhcRn FieldLabelString -> HsExpr GhcRn +mkGetField get_field arg field = + HsApp noExtField (mkGetFieldExpr get_field field) arg -- mkSetField a field b calculates a set_field @field expression. -- e.g mkSetSetField a field b = set_field @"field" a b (read as "set field 'field' to a on b"). @@ -2902,14 +2903,16 @@ 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 (mkGetFieldExpr getFieldName field) fields where - f :: HsExpr GhcRn -> FieldLabelString -> HsExpr GhcRn - f acc field = genHsApps circName $ map wrapGenSpan [proj field, acc] + f :: LHsExpr GhcRn -> XRec GhcRn FieldLabelString -> LHsExpr GhcRn + f acc field = wrapGenSpan $ genHsApps circName [mkGetFieldExpr getFieldName field, acc] - proj :: FieldLabelString -> HsExpr GhcRn - proj (FieldLabelString f) = genHsVar getFieldName `genAppType` genHsTyLit f +mkGetFieldExpr :: Name -> XRec GhcRn FieldLabelString -> LHsExpr GhcRn +mkGetFieldExpr getFieldName (L ann (FieldLabelString f)) = + wrapGenSpan' (getHasLoc ann) (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 ===================================== @@ -0,0 +1,65 @@ +{-# 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 + +prefix :: Thing -> Char +prefix x = (.field1) x +-- ^ this is the point + +prefixNested :: NestedThing -> Char +prefixNested x = (.nested1.field1) x +-- ^ this is the point +-- ^ this is the point + + +points = + [ (13,17) + , (16,25) + , (16,27) + , (23,17) + , (23,25) + , (27,20) + , (27,28) + , (33,22) + , (37,14) + , (41,21) + , (41,30) + ] + +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,244 @@ +========================== +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 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' +| └ +| +`- ┌ + │ 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 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' +| └ +| +`- ┌ + │ 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 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' +| └ +| +`- ┌ + │ 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: [$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: [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' + | └ + | + `- ┌ + │ 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> + └ + +========================== +At point (37,14), 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: [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' + | └ + | + `- ┌ + │ 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 (41,21), 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 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' +| └ +| +`- ┌ + │ 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 (41,30), 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 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' +| └ +| +`- ┌ + │ field1 at HasFieldQueries.hs:1:1, of type: Thing -> Char + │ is a usage of an external evidence variable + │ 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/NoFieldSelectorQueries.hs ===================================== @@ -0,0 +1,67 @@ +{-# LANGUAGE NoFieldSelectors #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE OverloadedRecordDot #-} +module Main where + +import TestUtils +import GHC.Records + +data A = A { a :: Int, b :: Char } +data B = B { a :: Int, n :: A } +data C + = C { c :: Float } + | D { c :: Float } + | E { e :: Int } + +valA = A { a = 1, b = 'b' } +valB = B { a = 1, n = valA } +valC = C { c = 1.0 } +valD = D { c = 2.0 } +valE = E { e = 1 } + +accessA :: Int +accessA = valA.a +-- ^ 1 + +accessField :: HasField "a" r Int => r -> Int +accessField r = r.a +-- ^ 2 + +nested = valB.n.b +-- ^ ^ +-- 3 4 +multi1a = valC.c +-- ^ +-- 5 +multi1b = valD.c +-- ^ +-- 6 +multi1c :: C -> Float +multi1c someC = someC.c -- Where does this point to? +-- ^ +-- 7 +multi3 = valE.e +-- ^ +-- 8 +multi4 = valD.e -- This is a run-time error, but where does it point to? +-- ^ +-- 9 + +points = + [ (23, 16) + , (27, 19) + , (30, 15) + , (30, 17) + , (33, 16) + , (36, 16) + , (40, 23) + , (43, 15) + , (46, 15) + ] + +main = do + (df, hf) <- readTestHie "NoFieldSelectorQueries.hie" + let refmap = generateReferencesMap $ getAsts $ hie_asts hf + + traverse (explainEv df hf refmap) points + return () ===================================== testsuite/tests/hiefile/should_run/NoFieldSelectorQueries.stdout ===================================== @@ -0,0 +1,211 @@ +========================== +At point (23,16), we found: +========================== +┌ +│ $dHasField at NoFieldSelectorQueries.hs:1:1, of type: HasField "a" A Int +│ is an evidence variable bound by a let, depending on: [C:HasField, +│ a of Record A] +│ with scope: ModuleScope +│ +│ Defined at <no location info> +└ +| ++- ┌ +| │ C:HasField at NoFieldSelectorQueries.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' +| └ +| +`- ┌ + │ a at NoFieldSelectorQueries.hs:1:1, of type: A -> Int + │ is a usage of an external evidence variable + │ Defined at NoFieldSelectorQueries.hs:9:14 + └ + +========================== +At point (27,19), we found: +========================== +┌ +│ $dHasField at NoFieldSelectorQueries.hs:27:1-19, of type: HasField "a" r Int +│ is an evidence variable bound by a let, depending on: [$dHasField] +│ with scope: LocalScope NoFieldSelectorQueries.hs:27:1-19 +│ bound at: NoFieldSelectorQueries.hs:27:1-19 +│ Defined at <no location info> +└ +| +`- ┌ + │ $dHasField at NoFieldSelectorQueries.hs:27:1-19, of type: HasField "a" r Int + │ is an evidence variable bound by a HsWrapper + │ with scope: LocalScope NoFieldSelectorQueries.hs:27:1-19 + │ bound at: NoFieldSelectorQueries.hs:27:1-19 + │ Defined at <no location info> + └ + +========================== +At point (30,15), we found: +========================== +┌ +│ $dHasField at NoFieldSelectorQueries.hs:30:1-17, of type: HasField "n" B A +│ is an evidence variable bound by a let, depending on: [C:HasField, +│ n of Record B] +│ with scope: LocalScope NoFieldSelectorQueries.hs:30:1-17 +│ bound at: NoFieldSelectorQueries.hs:30:1-17 +│ Defined at <no location info> +└ +| ++- ┌ +| │ C:HasField at NoFieldSelectorQueries.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' +| └ +| +`- ┌ + │ n at NoFieldSelectorQueries.hs:30:1-17, of type: B -> A + │ is a usage of an external evidence variable + │ Defined at NoFieldSelectorQueries.hs:10:24 + └ + +========================== +At point (30,17), we found: +========================== +┌ +│ $dHasField at NoFieldSelectorQueries.hs:30:1-17, of type: HasField "b" A Char +│ is an evidence variable bound by a let, depending on: [C:HasField, +│ b of Record A] +│ with scope: LocalScope NoFieldSelectorQueries.hs:30:1-17 +│ bound at: NoFieldSelectorQueries.hs:30:1-17 +│ Defined at <no location info> +└ +| ++- ┌ +| │ C:HasField at NoFieldSelectorQueries.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' +| └ +| +`- ┌ + │ b at NoFieldSelectorQueries.hs:30:1-17, of type: A -> Char + │ is a usage of an external evidence variable + │ Defined at NoFieldSelectorQueries.hs:9:24 + └ + +========================== +At point (33,16), we found: +========================== +┌ +│ $dHasField at NoFieldSelectorQueries.hs:33:1-16, of type: HasField "c" C Float +│ is an evidence variable bound by a let, depending on: [C:HasField, +│ c of Record C] +│ with scope: LocalScope NoFieldSelectorQueries.hs:33:1-16 +│ bound at: NoFieldSelectorQueries.hs:33:1-16 +│ Defined at <no location info> +└ +| ++- ┌ +| │ C:HasField at NoFieldSelectorQueries.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 at NoFieldSelectorQueries.hs:1:1, of type: C -> Float + │ is a usage of an external evidence variable + │ Defined at NoFieldSelectorQueries.hs:12:9 + └ + +========================== +At point (36,16), we found: +========================== +┌ +│ $dHasField at NoFieldSelectorQueries.hs:36:1-16, of type: HasField "c" C Float +│ is an evidence variable bound by a let, depending on: [C:HasField, +│ c of Record C] +│ with scope: LocalScope NoFieldSelectorQueries.hs:36:1-16 +│ bound at: NoFieldSelectorQueries.hs:36:1-16 +│ Defined at <no location info> +└ +| ++- ┌ +| │ C:HasField at NoFieldSelectorQueries.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 at NoFieldSelectorQueries.hs:1:1, of type: C -> Float + │ is a usage of an external evidence variable + │ Defined at NoFieldSelectorQueries.hs:12:9 + └ + +========================== +At point (40,23), we found: +========================== +┌ +│ $dHasField at NoFieldSelectorQueries.hs:1:1, of type: HasField "c" C Float +│ is an evidence variable bound by a let, depending on: [C:HasField, +│ c of Record C] +│ with scope: ModuleScope +│ +│ Defined at <no location info> +└ +| ++- ┌ +| │ C:HasField at NoFieldSelectorQueries.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 at NoFieldSelectorQueries.hs:1:1, of type: C -> Float + │ is a usage of an external evidence variable + │ Defined at NoFieldSelectorQueries.hs:12:9 + └ + +========================== +At point (43,15), we found: +========================== +┌ +│ $dHasField at NoFieldSelectorQueries.hs:43:1-15, of type: HasField "e" C Int +│ is an evidence variable bound by a let, depending on: [C:HasField, +│ e of Record C] +│ with scope: LocalScope NoFieldSelectorQueries.hs:43:1-15 +│ bound at: NoFieldSelectorQueries.hs:43:1-15 +│ Defined at <no location info> +└ +| ++- ┌ +| │ C:HasField at NoFieldSelectorQueries.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' +| └ +| +`- ┌ + │ e at NoFieldSelectorQueries.hs:43:1-15, of type: C -> Int + │ is a usage of an external evidence variable + │ Defined at NoFieldSelectorQueries.hs:14:9 + └ + +========================== +At point (46,15), we found: +========================== +┌ +│ $dHasField at NoFieldSelectorQueries.hs:46:1-15, of type: HasField "e" C Int +│ is an evidence variable bound by a let, depending on: [C:HasField, +│ e of Record C] +│ with scope: LocalScope NoFieldSelectorQueries.hs:46:1-15 +│ bound at: NoFieldSelectorQueries.hs:46:1-15 +│ Defined at <no location info> +└ +| ++- ┌ +| │ C:HasField at NoFieldSelectorQueries.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' +| └ +| +`- ┌ + │ e at NoFieldSelectorQueries.hs:43:1-15, of type: C -> Int + │ is a usage of an external evidence variable + │ Defined at NoFieldSelectorQueries.hs:14:9 + └ + ===================================== testsuite/tests/hiefile/should_run/RecordDotTypes.hs ===================================== @@ -22,6 +22,11 @@ x = MyRecord { a = "Hello", b = 12, c = MyChild { z = "there" } } y = x.a ++ show x.b ++ x.c.z -- ^ ^ ^ ^^ -- 1 2 3 45 +-- ^-^ ^-^ ^-^ +-- 6 7 8 +-- ^---^ +-- 9 + p1,p2,p3,p4 :: (Int,Int) p1 = (22,6) @@ -30,10 +35,19 @@ p3 = (22,25) p4 = (22,28) p5 = (22,29) +r6 = (p1, (22, 8)) +r7 = ((22,17), p2) +r8 = (p3, (22, 27)) +r9 = (p3, p5) + selectPoint' :: HieFile -> (Int,Int) -> HieAST Int selectPoint' hf loc = maybe (error "point not found") id $ selectPoint hf loc +selectRange' :: HieFile -> ((Int,Int), (Int, Int)) -> HieAST Int +selectRange' hf (s, e) = + maybe (error "range not found") id $ selectRange hf s e + main = do (df, hf) <- readTestHie "RecordDotTypes.hie" forM_ [p1,p2,p3,p4,p5] $ \point -> do @@ -41,3 +55,11 @@ main = do let types = concatMap nodeType $ getSourcedNodeInfo $ sourcedNodeInfo $ selectPoint' hf point forM_ types $ \typ -> do putStrLn (renderHieType df $ recoverFullType typ (hie_types hf)) + + forM_ [r6, r7, r8, r9] $ \range -> do + putStr $ "At " ++ showRange range ++ ", got type: " + let types = concatMap nodeType $ getSourcedNodeInfo $ sourcedNodeInfo $ selectRange' hf range + forM_ types $ \typ -> do + putStrLn (renderHieType df $ recoverFullType typ (hie_types hf)) + where + showRange (p1, p2) = show p1 ++ " - " ++ show p2 ===================================== testsuite/tests/hiefile/should_run/RecordDotTypes.stdout ===================================== @@ -1,5 +1,9 @@ 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] +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: [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,6 @@ 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('NoFieldSelectorQueries', [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/60018f321da594ab69733c61677e42c... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/60018f321da594ab69733c61677e42c... 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