summaryrefslogtreecommitdiff
path: root/testsuite
diff options
context:
space:
mode:
authorZubin Duggal <zubin@cmi.ac.in>2019-06-29 19:20:54 +0530
committerMarge Bot <ben+marge-bot@smart-cactus.org>2020-05-26 03:03:24 -0400
commit53814a6424240ab50201fdde81a6e7832c1aad3d (patch)
tree280f353ec25f060a00a0c7124bd7471a66bed64f /testsuite
parentb8c014ce27c279e0d506d5391a4e9bfa7f1c31f2 (diff)
downloadhaskell-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.hs25
-rw-r--r--testsuite/tests/hiefile/should_run/HieQueries.hs82
-rw-r--r--testsuite/tests/hiefile/should_run/HieQueries.stdout98
-rw-r--r--testsuite/tests/hiefile/should_run/PatTypes.hs15
-rw-r--r--testsuite/tests/hiefile/should_run/all.T1
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'])