Hannes Siebenhandl pushed to branch wip/fendor/has-field-hie at Glasgow Haskell Compiler / GHC
Commits:
-
8926227e
by fendor at 2026-09-16T11:43:40+02:00
3 changed files:
- compiler/GHC/Iface/Ext/Utils.hs
- testsuite/tests/hiefile/should_run/RecordDotTypes.hs
- testsuite/tests/hiefile/should_run/RecordDotTypes.stdout
Changes:
| ... | ... | @@ -82,15 +82,19 @@ resolveVisibility kind ty_args |
| 82 | 82 | foldType :: (HieType a -> a) -> HieTypeFix -> a
|
| 83 | 83 | foldType f (Roll t) = f $ fmap (foldType f) t
|
| 84 | 84 | |
| 85 | -selectPoint :: HieFile -> (Int,Int) -> Maybe (HieAST Int)
|
|
| 86 | -selectPoint hf (sl,sc) = getFirst $
|
|
| 85 | +selectPoint :: HieFile -> (Int,Int) -> Maybe (HieAST TypeIndex)
|
|
| 86 | +selectPoint hf p = selectRange hf p p
|
|
| 87 | + |
|
| 88 | +selectRange :: HieFile -> (Int,Int) -> (Int,Int) -> Maybe (HieAST TypeIndex)
|
|
| 89 | +selectRange hf (sl,sc) (el, ec) = getFirst $
|
|
| 87 | 90 | flip foldMap (M.toList (getAsts $ hie_asts hf)) $ \(HiePath fs,ast) -> First $
|
| 88 | 91 | case selectSmallestContaining (sp fs) ast of
|
| 89 | 92 | Nothing -> Nothing
|
| 90 | 93 | Just ast' -> Just ast'
|
| 91 | 94 | where
|
| 92 | 95 | sloc fs = mkRealSrcLoc fs sl sc
|
| 93 | - sp fs = mkRealSrcSpan (sloc fs) (sloc fs)
|
|
| 96 | + eloc fs = mkRealSrcLoc fs el ec
|
|
| 97 | + sp fs = mkRealSrcSpan (sloc fs) (eloc fs)
|
|
| 94 | 98 | |
| 95 | 99 | findEvidenceUse :: NodeIdentifiers a -> [Name]
|
| 96 | 100 | findEvidenceUse ni = [n | (Right n, dets) <- xs, any isEvidenceUse (identInfo dets)]
|
| ... | ... | @@ -22,6 +22,11 @@ x = MyRecord { a = "Hello", b = 12, c = MyChild { z = "there" } } |
| 22 | 22 | y = x.a ++ show x.b ++ x.c.z
|
| 23 | 23 | -- ^ ^ ^ ^^
|
| 24 | 24 | -- 1 2 3 45
|
| 25 | +-- ^-^ ^-^ ^-^
|
|
| 26 | +-- 6 7 8
|
|
| 27 | +-- ^---^
|
|
| 28 | +-- 9
|
|
| 29 | + |
|
| 25 | 30 | |
| 26 | 31 | p1,p2,p3,p4 :: (Int,Int)
|
| 27 | 32 | p1 = (22,6)
|
| ... | ... | @@ -30,10 +35,19 @@ p3 = (22,25) |
| 30 | 35 | p4 = (22,28)
|
| 31 | 36 | p5 = (22,29)
|
| 32 | 37 | |
| 38 | +r6 = (p1, (22, 8))
|
|
| 39 | +r7 = ((22,17), p2)
|
|
| 40 | +r8 = (p3, (22, 27))
|
|
| 41 | +r9 = (p3, p5)
|
|
| 42 | + |
|
| 33 | 43 | selectPoint' :: HieFile -> (Int,Int) -> HieAST Int
|
| 34 | 44 | selectPoint' hf loc =
|
| 35 | 45 | maybe (error "point not found") id $ selectPoint hf loc
|
| 36 | 46 | |
| 47 | +selectRange' :: HieFile -> ((Int,Int), (Int, Int)) -> HieAST Int
|
|
| 48 | +selectRange' hf (s, e) =
|
|
| 49 | + maybe (error "range not found") id $ selectRange hf s e
|
|
| 50 | + |
|
| 37 | 51 | main = do
|
| 38 | 52 | (df, hf) <- readTestHie "RecordDotTypes.hie"
|
| 39 | 53 | forM_ [p1,p2,p3,p4,p5] $ \point -> do
|
| ... | ... | @@ -41,3 +55,11 @@ main = do |
| 41 | 55 | let types = concatMap nodeType $ getSourcedNodeInfo $ sourcedNodeInfo $ selectPoint' hf point
|
| 42 | 56 | forM_ types $ \typ -> do
|
| 43 | 57 | putStrLn (renderHieType df $ recoverFullType typ (hie_types hf))
|
| 58 | + |
|
| 59 | + forM_ [r6, r7, r8, r9] $ \range -> do
|
|
| 60 | + putStr $ "At " ++ showRange range ++ ", got type: "
|
|
| 61 | + let types = concatMap nodeType $ getSourcedNodeInfo $ sourcedNodeInfo $ selectRange' hf range
|
|
| 62 | + forM_ types $ \typ -> do
|
|
| 63 | + putStrLn (renderHieType df $ recoverFullType typ (hie_types hf))
|
|
| 64 | + where
|
|
| 65 | + showRange (p1, p2) = show p1 ++ " - " ++ show p2 |
| ... | ... | @@ -3,3 +3,7 @@ At (22,20), got type: MyRecord -> Integer |
| 3 | 3 | At (22,25), got type: MyRecord
|
| 4 | 4 | At (22,28), got type: MyChild -> [Char]
|
| 5 | 5 | At (22,29), got type: MyChild -> [Char]
|
| 6 | +At (22,6) - (22,8), got type: [Char]
|
|
| 7 | +At (22,17) - (22,20), got type: Integer
|
|
| 8 | +At (22,25) - (22,27), got type: MyChild
|
|
| 9 | +At (22,25) - (22,29), got type: [Char] |