Zubin pushed to branch wip/hie-file-improvements at Glasgow Haskell Compiler / GHC
Commits:
-
d201a2a1
by Zubin Duggal at 2025-06-17T18:13:40+05:30
3 changed files:
- compiler/GHC/Iface/Ext/Ast.hs
- + testsuite/tests/hiefile/should_run/T25709.hs
- testsuite/tests/hiefile/should_run/all.T
Changes:
| ... | ... | @@ -680,7 +680,14 @@ evVarsOfTermList (EvTypeable _ ev) = |
| 680 | 680 | EvTypeableTyApp e1 e2 -> concatMap evVarsOfTermList [e1,e2]
|
| 681 | 681 | EvTypeableTrFun e1 e2 e3 -> concatMap evVarsOfTermList [e1,e2,e3]
|
| 682 | 682 | EvTypeableTyLit e -> evVarsOfTermList e
|
| 683 | -evVarsOfTermList (EvFun{}) = []
|
|
| 683 | +evVarsOfTermList (EvFun { et_given = givens, et_binds = EvBinds binds_b, et_body = body_id })
|
|
| 684 | + = let
|
|
| 685 | + binds = bagToList binds_b
|
|
| 686 | + lhs_evvars = S.fromList $ map evBindVar binds
|
|
| 687 | + rhs_evvars = S.fromList $ concatMap (evVarsOfTermList . eb_rhs) binds
|
|
| 688 | + in
|
|
| 689 | + S.toList $
|
|
| 690 | + ( ( S.insert body_id rhs_evvars ) S.\\ S.fromList givens ) S.\\ lhs_evvars
|
|
| 684 | 691 | |
| 685 | 692 | instance ToHie (EvBindContext (LocatedA TcEvBinds)) where
|
| 686 | 693 | toHie (EvBindContext sc sp (L span (EvBinds bs)))
|
| 1 | +{-# LANGUAGE QuantifiedConstraints#-}
|
|
| 2 | +{-# LANGUAGE UndecidableInstances #-}
|
|
| 3 | +module Main where
|
|
| 4 | + |
|
| 5 | +import TestUtils
|
|
| 6 | +import qualified Data.Map.Strict as M
|
|
| 7 | +import qualified Data.Set as S
|
|
| 8 | +import Data.Either
|
|
| 9 | +import Data.Maybe
|
|
| 10 | +import Data.Bifunctor (first)
|
|
| 11 | +import GHC.Plugins (moduleNameString, nameStableString, nameOccName, occNameString, isDerivedOccName)
|
|
| 12 | +import GHC.Iface.Ext.Types
|
|
| 13 | + |
|
| 14 | + |
|
| 15 | +import Data.Typeable
|
|
| 16 | + |
|
| 17 | +data Some c where
|
|
| 18 | + Some :: c a => a -> Some c
|
|
| 19 | + |
|
| 20 | +extractSome :: (Typeable a, forall x. c x => Typeable x) => Some c -> Maybe a
|
|
| 21 | +extractSome (Some a) = cast a
|
|
| 22 | + |
|
| 23 | +points :: [(Int,Int)]
|
|
| 24 | +points = [(21,11)]
|
|
| 25 | + |
|
| 26 | +main = do
|
|
| 27 | + (df, hf) <- readTestHie "T25709.hie"
|
|
| 28 | + undefined |
| ... | ... | @@ -7,4 +7,5 @@ test('SpliceTypes', [req_th, extra_run_opts('"' + config.libdir + '"'), extra_fi |
| 7 | 7 | test('HieVdq', [extra_run_opts('"' + config.libdir + '"'), extra_files(['TestUtils.hs'])], compile_and_run, ['-package ghc -fwrite-ide-info'])
|
| 8 | 8 | test('T23540', [extra_run_opts('"' + config.libdir + '"'), extra_files(['TestUtils.hs'])], compile_and_run, ['-package ghc -fwrite-ide-info'])
|
| 9 | 9 | test('T23120', [extra_run_opts('"' + config.libdir + '"'), extra_files(['TestUtils.hs'])], compile_and_run, ['-package ghc -fwrite-ide-info'])
|
| 10 | -test('T24544', [extra_run_opts('"' + config.libdir + '"'), extra_files(['TestUtils.hs'])], compile_and_run, ['-package ghc -fwrite-ide-info']) |
|
| \ No newline at end of file | ||
| 10 | +test('T24544', [extra_run_opts('"' + config.libdir + '"'), extra_files(['TestUtils.hs'])], compile_and_run, ['-package ghc -fwrite-ide-info'])
|
|
| 11 | +test('T25709', [extra_run_opts('"' + config.libdir + '"'), extra_files(['TestUtils.hs'])], compile_and_run, ['-package ghc -fwrite-ide-info']) |