Hannes Siebenhandl pushed to branch wip/hie-file-improvements at Glasgow Haskell Compiler / GHC

Commits:

5 changed files:

Changes:

  • compiler/GHC/Driver/Main/Passes.hs
    ... ... @@ -92,7 +92,7 @@ import GHC.Iface.Make
    92 92
     import GHC.Iface.Recomp
    
    93 93
     import GHC.Iface.Tidy
    
    94 94
     import GHC.Iface.Ext.Ast    ( mkHieFile )
    
    95
    -import GHC.Iface.Ext.Types  ( getAsts, hie_asts, hie_module )
    
    95
    +import GHC.Iface.Ext.Types  ( getAsts, hie_asts, hie_module, hie_types )
    
    96 96
     import GHC.Iface.Ext.Binary ( readHieFile, writeHieFile , hie_file_result)
    
    97 97
     import GHC.Iface.Ext.Debug  ( diffFile, validateScopes )
    
    98 98
     
    
    ... ... @@ -167,7 +167,7 @@ import GHC.Data.StringBuffer
    167 167
     import GHC.Data.Maybe
    
    168 168
     import qualified GHC.Data.Strict as Strict
    
    169 169
     
    
    170
    -
    
    170
    +import qualified Data.Array as A
    
    171 171
     import Data.List ( nub, isPrefixOf, partition )
    
    172 172
     import qualified Data.List.NonEmpty as NE
    
    173 173
     import Control.Monad
    
    ... ... @@ -332,7 +332,10 @@ extract_renamed_stuff mod_summary tc_result = do
    332 332
             hieFile <- mkHieFile mod_summary tc_result (fromJust rn_info)
    
    333 333
             let out_file = ml_hie_file $ ms_location mod_summary
    
    334 334
             liftIO $ writeHieFile out_file hieFile
    
    335
    -        liftIO $ putDumpFileMaybe logger Opt_D_dump_hie "HIE AST" FormatHaskell (ppr $ hie_asts hieFile)
    
    335
    +        let hie_doc =
    
    336
    +                  ppr (hie_asts hieFile)
    
    337
    +              $+$ ppr (A.assocs $ hie_types hieFile)
    
    338
    +        liftIO $ putDumpFileMaybe logger Opt_D_dump_hie "HIE AST" FormatHaskell hie_doc
    
    336 339
     
    
    337 340
             -- Validate HIE files
    
    338 341
             when (gopt Opt_ValidateHie dflags) $ do
    

  • compiler/GHC/Iface/Ext/Types.hs
    ... ... @@ -159,6 +159,18 @@ data HieType a
    159 159
       | HCoercionTy
    
    160 160
         deriving (Functor, Foldable, Traversable, Eq)
    
    161 161
     
    
    162
    +instance Outputable a => Outputable (HieType a) where
    
    163
    +  ppr (HTyVarTy name) = ppr name
    
    164
    +  ppr (HAppTy fun arg) = parens $ ppr fun <+> ppr arg
    
    165
    +  ppr (HTyConApp tc args) = parens $ ppr tc <+> ppr args
    
    166
    +  ppr (HForAllTy ((name, ty), flag) body) =
    
    167
    +    text "forall" <+> ppr flag <+> ppr name O.<> text ":" <+> ppr ty O.<> text "." <+> ppr body
    
    168
    +  ppr (HFunTy mult arg res) = parens $ ppr arg <+> arrow <+> ppr res <+> ppr mult
    
    169
    +  ppr (HQualTy ctxt ty) = parens $ ppr ctxt <+> text "=>" <+> ppr ty
    
    170
    +  ppr (HLitTy lit) = ppr lit
    
    171
    +  ppr (HCastTy ty) = text "cast" <+> ppr ty
    
    172
    +  ppr HCoercionTy = text "<coercion>"
    
    173
    +
    
    162 174
     type HieTypeFlat = HieType TypeIndex
    
    163 175
     
    
    164 176
     -- | Roughly isomorphic to the original core 'Type'.
    
    ... ... @@ -222,6 +234,10 @@ instance Binary (HieArgs TypeIndex) where
    222 234
       put_ bh (HieArgs xs) = put_ bh xs
    
    223 235
       get bh = HieArgs <$> get bh
    
    224 236
     
    
    237
    +instance Outputable a => Outputable (HieArgs a) where
    
    238
    +  ppr (HieArgs args) = braces $ hsep $ punctuate comma $ map pprArg args
    
    239
    +    where pprArg (vis, ty) = (if vis then id else parens) (ppr ty)
    
    240
    +
    
    225 241
     
    
    226 242
     -- A HiePath is just a lexical FastString. We use a lexical FastString to avoid
    
    227 243
     -- non-determinism when printing or storing HieASTs which are sorted by their
    

  • testsuite/tests/hiefile/should_run/T25709.hs
    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,26)]
    
    25
    +
    
    26
    +main = do
    
    27
    +  (df, hf) <- readTestHie "T25709.hie"
    
    28
    +  let refmap = generateReferencesMap $ getAsts $ hie_asts hf
    
    29
    +  traverse (explainEv df hf refmap) points

  • testsuite/tests/hiefile/should_run/T25709.stdout
    1
    +==========================
    
    2
    +At point (21,26), we found:
    
    3
    +==========================
    
    4
    +
    
    5
    +│ $dTypeable at T25709.hs:21:14-19, of type: Typeable a
    
    6
    +│     is an evidence variable bound by a let, depending on: [$dTypeable]
    
    7
    +│           with scope: LocalScope T25709.hs:21:14-29
    
    8
    +
    
    9
    +│     Defined at <no location info>
    
    10
    +
    
    11
    +|
    
    12
    +`- ┌
    
    13
    +   │ $dTypeable at T25709.hs:21:1-29, of type: Typeable a
    
    14
    +   │     is an evidence variable bound by a HsWrapper
    
    15
    +   │           with scope: LocalScope T25709.hs:21:1-29
    
    16
    +   │           bound at: T25709.hs:21:1-29
    
    17
    +   │     Defined at <no location info>
    
    18
    +
    
    19
    +
    
    20
    +
    
    21
    +│ $dTypeable at T25709.hs:21:14-19, of type: Typeable a
    
    22
    +│     is an evidence variable bound by a let, depending on: [df, irred]
    
    23
    +│           with scope: LocalScope T25709.hs:21:14-29
    
    24
    +
    
    25
    +│     Defined at <no location info>
    
    26
    +
    
    27
    +|
    
    28
    ++- ┌
    
    29
    +|  │ df at T25709.hs:21:1-29, of type: forall x. c x => Typeable x
    
    30
    +|  │     is an evidence variable bound by a HsWrapper
    
    31
    +|  │           with scope: LocalScope T25709.hs:21:1-29
    
    32
    +|  │           bound at: T25709.hs:21:1-29
    
    33
    +|  │     Defined at <no location info>
    
    34
    +|  └
    
    35
    +|
    
    36
    +`- ┌
    
    37
    +   │ irred at T25709.hs:21:14-19, of type: c a
    
    38
    +   │     is an evidence variable bound by a let, depending on: [irred]
    
    39
    +   │           with scope: LocalScope T25709.hs:21:14-29
    
    40
    +
    
    41
    +   │     Defined at <no location info>
    
    42
    +
    
    43
    +   |
    
    44
    +   `- ┌
    
    45
    +      │ irred at T25709.hs:21:14-19, of type: c a
    
    46
    +      │     is an evidence variable bound by a pattern
    
    47
    +      │           with scope: LocalScope T25709.hs:21:14-29
    
    48
    +
    
    49
    +      │     Defined at <no location info>
    
    50
    +
    
    51
    +

  • testsuite/tests/hiefile/should_run/all.T
    ... ... @@ -8,4 +8,5 @@ test('HieVdq', [extra_run_opts('"' + config.libdir + '"'), extra_files(['TestUti
    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 10
     test('T24544', [extra_run_opts('"' + config.libdir + '"'), extra_files(['TestUtils.hs'])], compile_and_run, ['-package ghc -fwrite-ide-info'])
    
    11
    -test('HieGadtConSigs', [extra_run_opts('"' + config.libdir + '"'), extra_files(['TestUtils.hs'])], compile_and_run, ['-package ghc -fwrite-ide-info'])
    \ No newline at end of file
    11
    +test('HieGadtConSigs', [extra_run_opts('"' + config.libdir + '"'), extra_files(['TestUtils.hs'])], compile_and_run, ['-package ghc -fwrite-ide-info'])
    
    12
    +test('T25709', [extra_run_opts('"' + config.libdir + '"'), extra_files(['TestUtils.hs'])], compile_and_run, ['-package ghc -fwrite-ide-info'])