diff options
author | Zubin Duggal <zubin@cmi.ac.in> | 2019-06-29 19:20:54 +0530 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2020-05-26 03:03:24 -0400 |
commit | 53814a6424240ab50201fdde81a6e7832c1aad3d (patch) | |
tree | 280f353ec25f060a00a0c7124bd7471a66bed64f /testsuite | |
parent | b8c014ce27c279e0d506d5391a4e9bfa7f1c31f2 (diff) | |
download | haskell-53814a6424240ab50201fdde81a6e7832c1aad3d.tar.gz |
Add info about typeclass evidence to .hie files
See `testsuite/tests/hiefile/should_run/HieQueries.hs` and
`testsuite/tests/hiefile/should_run/HieQueries.stdout` for an example of this
We add two new fields, `EvidenceVarBind` and `EvidenceVarUse` to the
`ContextInfo` associated with an Identifier. These are associated with the
appropriate identifiers for the evidence variables collected when we come across
`HsWrappers`, `TcEvBinds` and `IPBinds` while traversing the AST.
Instance dictionary and superclass selector dictionaries from `tcg_insts` and
classes defined in `tcg_tcs` are also recorded in the AST as originating from
their definition span
This allows us to save a complete picture of the evidence constructed by the
constraint solver, and will let us report this to the user, enabling features
like going to the instance definition from the invocation of a class method(or
any other method taking a constraint) and finding all usages of a particular
instance.
Additionally,
- Mark NodeInfo with an origin so we can differentiate between bindings
origininating in the source vs those in ghc
- Along with typeclass evidence info, also include information on Implicit
Parameters
- Add a few utility functions to HieUtils in order to query the new info
Updates haddock submodule
Diffstat (limited to 'testsuite')
-rw-r--r-- | testsuite/tests/hiefile/should_compile/Scopes.hs | 25 | ||||
-rw-r--r-- | testsuite/tests/hiefile/should_run/HieQueries.hs | 82 | ||||
-rw-r--r-- | testsuite/tests/hiefile/should_run/HieQueries.stdout | 98 | ||||
-rw-r--r-- | testsuite/tests/hiefile/should_run/PatTypes.hs | 15 | ||||
-rw-r--r-- | testsuite/tests/hiefile/should_run/all.T | 1 |
5 files changed, 209 insertions, 12 deletions
diff --git a/testsuite/tests/hiefile/should_compile/Scopes.hs b/testsuite/tests/hiefile/should_compile/Scopes.hs index e3cbd8558f..f8a76298bb 100644 --- a/testsuite/tests/hiefile/should_compile/Scopes.hs +++ b/testsuite/tests/hiefile/should_compile/Scopes.hs @@ -1,10 +1,33 @@ +{-# LANGUAGE PatternSynonyms, ViewPatterns #-} +{-# LANGUAGE ImplicitParams #-} {-# LANGUAGE RecordWildCards #-} module Scopes where + +-- Verify that evidence bound by patern +-- synonyms has correct scope +pattern LL :: Num a => a -> a +pattern LL x <- (subtract 1 -> x) + where + LL x = x + 1 + data T = C { x :: Int, y :: Char } --- Verify that names generated from record construction are in scope +-- Verify that names generated from record construction +-- have correct scope foo = C { x = 1 , y = 'a' } +-- Verify that implicit paramters have correct scope +bar :: (?x :: Int) => Int +bar = ?x + 1 + +baz :: Int +baz = bar + ?x + where ?x = 2 + +-- Verify that variables bound in pattern +-- synonyms have the correct scope +pattern A a b = (a , b) + -- Verify that record wildcards are in scope sdaf :: T sdaf = C{..} diff --git a/testsuite/tests/hiefile/should_run/HieQueries.hs b/testsuite/tests/hiefile/should_run/HieQueries.hs new file mode 100644 index 0000000000..f349854dc4 --- /dev/null +++ b/testsuite/tests/hiefile/should_run/HieQueries.hs @@ -0,0 +1,82 @@ +{-# LANGUAGE ScopedTypeVariables #-} +module Main where + +import System.Environment + +import GHC.Types.Name.Cache +import GHC.Types.SrcLoc +import GHC.Types.Unique.Supply +import GHC.Types.Name +import Data.Tree +import GHC.Iface.Ext.Binary +import GHC.Iface.Ext.Types +import GHC.Iface.Ext.Utils +import Data.Maybe (fromJust) +import GHC.Driver.Session +import GHC.SysTools +import GHC.Utils.Outputable ( Outputable, renderWithStyle, ppr, defaultUserStyle, initSDocContext, text) +import qualified Data.Map as M +import Data.Foldable + +class C a where + f :: a -> Char + +instance C Char where + f x = x + +instance C a => C [a] where + f x = 'a' + +foo :: C a => a -> Char +foo x = f [x] +-- ^ this is the point +point :: (Int,Int) +point = (31,9) + +bar :: Show x => x -> String +bar x = show [(1,x,A)] +-- ^ this is the point' +point' :: (Int,Int) +point' = (37,9) + +data A = A deriving Show + +makeNc :: IO NameCache +makeNc = do + uniq_supply <- mkSplitUniqSupply 'z' + return $ initNameCache uniq_supply [] + +dynFlagsForPrinting :: String -> IO DynFlags +dynFlagsForPrinting libdir = do + systemSettings <- initSysTools libdir + return $ defaultDynFlags systemSettings (LlvmConfig [] []) + +main = do + libdir:_ <- getArgs + df <- dynFlagsForPrinting libdir + nc <- makeNc + hfr <- readHieFile (NCU (\f -> pure $ snd $ f nc)) "HieQueries.hie" + let hf = hie_file_result hfr + refmap = generateReferencesMap $ getAsts $ hie_asts hf + explainEv df hf refmap point + explainEv df hf refmap point' + return () + +explainEv :: DynFlags -> HieFile -> RefMap Int -> (Int,Int) -> IO () +explainEv df hf refmap point = do + putStrLn $ replicate 26 '=' + putStrLn $ "At point " ++ show point ++ ", we found:" + putStrLn $ replicate 26 '=' + putStr $ drawForest ptrees + where + trees = getEvidenceTreesAtPoint hf refmap point + + ptrees = fmap (pprint . fmap expandType) <$> trees + + expandType = text . renderHieType df . + flip recoverFullType (hie_types hf) + + pretty = unlines . (++["└"]) . ("┌":) . map ("│ "++) . lines + + pprint = pretty . renderWithStyle (initSDocContext df sty) . ppr + sty = defaultUserStyle diff --git a/testsuite/tests/hiefile/should_run/HieQueries.stdout b/testsuite/tests/hiefile/should_run/HieQueries.stdout new file mode 100644 index 0000000000..59bfb1d19d --- /dev/null +++ b/testsuite/tests/hiefile/should_run/HieQueries.stdout @@ -0,0 +1,98 @@ +========================== +At point (31,9), we found: +========================== +┌ +│ $dC at HieQueries.hs:31:1-13, of type: C [a] +│ is an evidence variable bound by a let, depending on: [$fC[], $dC] +│ with scope: LocalScope HieQueries.hs:31:1-13 +│ bound at: HieQueries.hs:31:1-13 +│ Defined at <no location info> +└ +| ++- ┌ +| │ $fC[] at HieQueries.hs:27:10-21, of type: forall a. C a => C [a] +| │ is an evidence variable bound by an instance of class C +| │ with scope: ModuleScope +| │ +| │ Defined at HieQueries.hs:27:10 +| └ +| +`- ┌ + │ $dC at HieQueries.hs:31:1-13, of type: C a + │ is an evidence variable bound by a type signature + │ with scope: LocalScope HieQueries.hs:31:1-13 + │ bound at: HieQueries.hs:31:1-13 + │ Defined at <no location info> + └ + +========================== +At point (37,9), we found: +========================== +┌ +│ $dShow at HieQueries.hs:37:1-22, of type: Show [(Integer, x, A)] +│ is an evidence variable bound by a let, depending on: [$fShow[], +│ $dShow] +│ with scope: LocalScope HieQueries.hs:37:1-22 +│ bound at: HieQueries.hs:37:1-22 +│ Defined at <no location info> +└ +| ++- ┌ +| │ $fShow[] at HieQueries.hs:37:1-22, of type: forall a. Show a => Show [a] +| │ is a usage of an external evidence variable +| │ Defined in `GHC.Show' +| └ +| +`- ┌ + │ $dShow at HieQueries.hs:37:1-22, of type: Show (Integer, x, A) + │ is an evidence variable bound by a let, depending on: [$fShow(,,), + │ $dShow, $dShow, $dShow] + │ with scope: LocalScope HieQueries.hs:37:1-22 + │ bound at: HieQueries.hs:37:1-22 + │ Defined at <no location info> + └ + | + +- ┌ + | │ $fShow(,,) at HieQueries.hs:37:1-22, of type: forall a b c. (Show a, Show b, Show c) => Show (a, b, c) + | │ is a usage of an external evidence variable + | │ Defined in `GHC.Show' + | └ + | + +- ┌ + | │ $dShow at HieQueries.hs:37:1-22, of type: Show Integer + | │ is an evidence variable bound by a let, depending on: [$fShowInteger] + | │ with scope: LocalScope HieQueries.hs:37:1-22 + | │ bound at: HieQueries.hs:37:1-22 + | │ Defined at <no location info> + | └ + | | + | `- ┌ + | │ $fShowInteger at HieQueries.hs:37:1-22, of type: Show Integer + | │ is a usage of an external evidence variable + | │ Defined in `GHC.Show' + | └ + | + +- ┌ + | │ $dShow at HieQueries.hs:37:1-22, of type: Show x + | │ is an evidence variable bound by a type signature + | │ with scope: LocalScope HieQueries.hs:37:1-22 + | │ bound at: HieQueries.hs:37:1-22 + | │ Defined at <no location info> + | └ + | + `- ┌ + │ $dShow at HieQueries.hs:37:1-22, of type: Show A + │ is an evidence variable bound by a let, depending on: [$fShowA] + │ with scope: LocalScope HieQueries.hs:37:1-22 + │ bound at: HieQueries.hs:37:1-22 + │ Defined at <no location info> + └ + | + `- ┌ + │ $fShowA at HieQueries.hs:42:21-24, of type: Show A + │ is an evidence variable bound by an instance of class Show + │ with scope: ModuleScope + │ + │ Defined at HieQueries.hs:42:21 + └ + diff --git a/testsuite/tests/hiefile/should_run/PatTypes.hs b/testsuite/tests/hiefile/should_run/PatTypes.hs index 9f181c8577..39b9b59f78 100644 --- a/testsuite/tests/hiefile/should_run/PatTypes.hs +++ b/testsuite/tests/hiefile/should_run/PatTypes.hs @@ -42,16 +42,9 @@ dynFlagsForPrinting libdir = do systemSettings <- initSysTools libdir return $ defaultDynFlags systemSettings (LlvmConfig [] []) -selectPoint :: HieFile -> (Int,Int) -> HieAST Int -selectPoint hf (sl,sc) = case M.toList (getAsts $ hie_asts hf) of - [(fs,ast)] -> - case selectSmallestContaining (sp fs) ast of - Nothing -> error "point not found" - Just ast' -> ast' - _ -> error "map should only contain a single AST" - where - sloc fs = mkRealSrcLoc fs sl sc - sp fs = mkRealSrcSpan (sloc fs) (sloc fs) +selectPoint' :: HieFile -> (Int,Int) -> HieAST Int +selectPoint' hf loc = + maybe (error "point not found") id $ selectPoint hf loc main = do libdir:_ <- getArgs @@ -61,6 +54,6 @@ main = do let hf = hie_file_result hfr forM_ [p1,p2,p3,p4] $ \point -> do putStr $ "At " ++ show point ++ ", got type: " - let types = nodeType $ nodeInfo $ selectPoint hf point + let types = concatMap nodeType $ getSourcedNodeInfo $ sourcedNodeInfo $ selectPoint' hf point forM_ types $ \typ -> do putStrLn (renderHieType df $ recoverFullType typ (hie_types hf)) diff --git a/testsuite/tests/hiefile/should_run/all.T b/testsuite/tests/hiefile/should_run/all.T index 738dadcbe5..55dc8d1722 100644 --- a/testsuite/tests/hiefile/should_run/all.T +++ b/testsuite/tests/hiefile/should_run/all.T @@ -1 +1,2 @@ test('PatTypes', [extra_run_opts('"' + config.libdir + '"')], compile_and_run, ['-package ghc -fwrite-ide-info']) +test('HieQueries', [extra_run_opts('"' + config.libdir + '"')], compile_and_run, ['-package ghc -fwrite-ide-info']) |