Commit 05d86c7c authored by wz1000's avatar wz1000

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
parent 568d7279
Pipeline #19545 failed with stages
in 80 minutes and 29 seconds
This diff is collapsed.
......@@ -24,7 +24,6 @@ import GHC.Utils.Binary
import GHC.Iface.Binary ( getDictFastString )
import GHC.Data.FastMutInt
import GHC.Data.FastString ( FastString )
import GHC.Unit.Module ( Module )
import GHC.Types.Name
import GHC.Types.Name.Cache
import GHC.Utils.Outputable
......@@ -33,7 +32,6 @@ import GHC.Types.SrcLoc as SrcLoc
import GHC.Types.Unique.Supply ( takeUniqFromSupply )
import GHC.Types.Unique
import GHC.Types.Unique.FM
import GHC.Utils.Misc
import GHC.Iface.Env (NameCacheUpdater(..))
import qualified Data.Array as A
......@@ -49,42 +47,6 @@ import System.FilePath ( takeDirectory )
import GHC.Iface.Ext.Types
-- | `Name`'s get converted into `HieName`'s before being written into @.hie@
-- files. See 'toHieName' and 'fromHieName' for logic on how to convert between
-- these two types.
data HieName
= ExternalName !Module !OccName !SrcSpan
| LocalName !OccName !SrcSpan
| KnownKeyName !Unique
deriving (Eq)
instance Ord HieName where
compare (ExternalName a b c) (ExternalName d e f) = compare (a,b) (d,e) `thenCmp` SrcLoc.leftmost_smallest c f
-- TODO (int-index): Perhaps use RealSrcSpan in HieName?
compare (LocalName a b) (LocalName c d) = compare a c `thenCmp` SrcLoc.leftmost_smallest b d
-- TODO (int-index): Perhaps use RealSrcSpan in HieName?
compare (KnownKeyName a) (KnownKeyName b) = nonDetCmpUnique a b
-- Not actually non deterministic as it is a KnownKey
compare ExternalName{} _ = LT
compare LocalName{} ExternalName{} = GT
compare LocalName{} _ = LT
compare KnownKeyName{} _ = GT
instance Outputable HieName where
ppr (ExternalName m n sp) = text "ExternalName" <+> ppr m <+> ppr n <+> ppr sp
ppr (LocalName n sp) = text "LocalName" <+> ppr n <+> ppr sp
ppr (KnownKeyName u) = text "KnownKeyName" <+> ppr u
hieNameOcc :: HieName -> OccName
hieNameOcc (ExternalName _ occ _) = occ
hieNameOcc (LocalName occ _) = occ
hieNameOcc (KnownKeyName u) =
case lookupKnownKeyName u of
Just n -> nameOccName n
Nothing -> pprPanic "hieNameOcc:unknown known-key unique"
(ppr (unpkUnique u))
data HieSymbolTable = HieSymbolTable
{ hie_symtab_next :: !FastMutInt
, hie_symtab_map :: !(IORef (UniqFM (Int, HieName)))
......@@ -353,14 +315,6 @@ putName (HieSymbolTable next ref) bh name = do
-- ** Converting to and from `HieName`'s
toHieName :: Name -> HieName
toHieName name
| isKnownKeyName name = KnownKeyName (nameUnique name)
| isExternalName name = ExternalName (nameModule name)
(nameOccName name)
(nameSrcSpan name)
| otherwise = LocalName (nameOccName name) (nameSrcSpan name)
fromHieName :: NameCache -> HieName -> (NameCache, Name)
fromHieName nc (ExternalName mod occ span) =
let cache = nsNames nc
......
......@@ -15,7 +15,6 @@ import GHC.Data.FastString
import GHC.Utils.Outputable
import GHC.Iface.Ext.Types
import GHC.Iface.Ext.Binary
import GHC.Iface.Ext.Utils
import GHC.Types.Name
......@@ -39,17 +38,18 @@ diffAst diffType (Node info1 span1 xs1) (Node info2 span2 xs2) =
spanDiff
| span1 /= span2 = [hsep ["Spans", ppr span1, "and", ppr span2, "differ"]]
| otherwise = []
infoDiff'
= (diffList eqDiff `on` (S.toAscList . nodeAnnotations)) info1 info2
++ (diffList diffType `on` nodeType) info1 info2
++ (diffIdents `on` nodeIdentifiers) info1 info2
infoDiff = case infoDiff' of
infoDiff' i1 i2
= (diffList eqDiff `on` (S.toAscList . nodeAnnotations)) i1 i2
++ (diffList diffType `on` nodeType) i1 i2
++ (diffIdents `on` nodeIdentifiers) i1 i2
sinfoDiff = diffList (\(k1,a) (k2,b) -> eqDiff k1 k2 ++ infoDiff' a b) `on` (M.toList . getSourcedNodeInfo)
infoDiff = case sinfoDiff info1 info2 of
[] -> []
xs -> xs ++ [vcat ["In Node:",ppr (nodeIdentifiers info1,span1)
, "and", ppr (nodeIdentifiers info2,span2)
xs -> xs ++ [vcat ["In Node:",ppr (sourcedNodeIdents info1,span1)
, "and", ppr (sourcedNodeIdents info2,span2)
, "While comparing"
, ppr (normalizeIdents $ nodeIdentifiers info1), "and"
, ppr (normalizeIdents $ nodeIdentifiers info2)
, ppr (normalizeIdents $ sourcedNodeIdents info1), "and"
, ppr (normalizeIdents $ sourcedNodeIdents info2)
]
]
......@@ -107,11 +107,24 @@ validAst (Node _ span children) = do
-- | Look for any identifiers which occur outside of their supposed scopes.
-- Returns a list of error messages.
validateScopes :: Module -> M.Map FastString (HieAST a) -> [SDoc]
validateScopes mod asts = validScopes
validateScopes mod asts = validScopes ++ validEvs
where
refMap = generateReferencesMap asts
-- We use a refmap for most of the computation
evs = M.keys
$ M.filter (any isEvidenceContext . concatMap (S.toList . identInfo . snd)) refMap
validEvs = do
i@(Right ev) <- evs
case M.lookup i refMap of
Nothing -> ["Impossible, ev"<+> ppr ev <+> "not found in refmap" ]
Just refs
| nameIsLocalOrFrom mod ev
, not (any isEvidenceBind . concatMap (S.toList . identInfo . snd) $ refs)
-> ["Evidence var" <+> ppr ev <+> "not bound in refmap"]
| otherwise -> []
-- Check if all the names occur in their calculated scopes
validScopes = M.foldrWithKey (\k a b -> valid k a ++ b) [] refMap
valid (Left _) _ = []
......@@ -122,15 +135,18 @@ validateScopes mod asts = validScopes
Just xs -> xs
Nothing -> []
inScope (sp, dets)
| (definedInAsts asts n)
| (definedInAsts asts n || (any isEvidenceContext (identInfo dets)))
&& any isOccurrence (identInfo dets)
-- We validate scopes for names which are defined locally, and occur
-- in this span
-- in this span, or are evidence variables
= case scopes of
[] | (nameIsLocalOrFrom mod n
&& not (isDerivedOccName $ nameOccName n))
-- If we don't get any scopes for a local name then its an error.
-- We can ignore derived names.
[] | nameIsLocalOrFrom mod n
, ( not (isDerivedOccName $ nameOccName n)
|| any isEvidenceContext (identInfo dets))
-- If we don't get any scopes for a local name or
-- an evidence variable, then its an error.
-- We can ignore other kinds of derived names as
-- long as we take evidence vars into account
-> return $ hsep $
[ "Locally defined Name", ppr n,pprDefinedAt n , "at position", ppr sp
, "Doesn't have a calculated scope: ", ppr scopes]
......
......@@ -17,13 +17,16 @@ import GHC.Prelude
import Config
import GHC.Utils.Binary
import GHC.Data.FastString ( FastString )
import GHC.Builtin.Utils
import GHC.Iface.Type
import GHC.Unit.Module ( ModuleName, Module )
import GHC.Types.Name ( Name )
import GHC.Unit.Module ( ModuleName, Module )
import GHC.Types.Name
import GHC.Utils.Outputable hiding ( (<>) )
import GHC.Types.SrcLoc ( RealSrcSpan )
import GHC.Types.SrcLoc
import GHC.Types.Avail
import GHC.Types.Unique
import qualified GHC.Utils.Outputable as O ( (<>) )
import GHC.Utils.Misc
import qualified Data.Array as A
import qualified Data.Map as M
......@@ -33,6 +36,8 @@ import Data.Data ( Typeable, Data )
import Data.Semigroup ( Semigroup(..) )
import Data.Word ( Word8 )
import Control.Applicative ( (<|>) )
import Data.Coerce ( coerce )
import Data.Function ( on )
type Span = RealSrcSpan
......@@ -222,17 +227,16 @@ instance Outputable a => Outputable (HieASTs a) where
, rest
]
data HieAST a =
Node
{ nodeInfo :: NodeInfo a
{ sourcedNodeInfo :: SourcedNodeInfo a
, nodeSpan :: Span
, nodeChildren :: [HieAST a]
} deriving (Functor, Foldable, Traversable)
instance Binary (HieAST TypeIndex) where
put_ bh ast = do
put_ bh $ nodeInfo ast
put_ bh $ sourcedNodeInfo ast
put_ bh $ nodeSpan ast
put_ bh $ nodeChildren ast
......@@ -247,6 +251,38 @@ instance Outputable a => Outputable (HieAST a) where
header = text "Node@" O.<> ppr sp O.<> ":" <+> ppr ni
rest = vcat (map ppr ch)
-- | NodeInfos grouped by source
newtype SourcedNodeInfo a = SourcedNodeInfo { getSourcedNodeInfo :: (M.Map NodeOrigin (NodeInfo a)) }
deriving (Functor, Foldable, Traversable)
instance Binary (SourcedNodeInfo TypeIndex) where
put_ bh asts = put_ bh $ M.toAscList $ getSourcedNodeInfo asts
get bh = SourcedNodeInfo <$> fmap M.fromDistinctAscList (get bh)
instance Outputable a => Outputable (SourcedNodeInfo a) where
ppr (SourcedNodeInfo asts) = M.foldrWithKey go "" asts
where
go k a rest = vcat $
[ "Source: " O.<> ppr k
, ppr a
, rest
]
-- | Source of node info
data NodeOrigin
= SourceInfo
| GeneratedInfo
deriving (Eq, Enum, Ord)
instance Outputable NodeOrigin where
ppr SourceInfo = text "From source"
ppr GeneratedInfo = text "generated by ghc"
instance Binary NodeOrigin where
put_ bh b = putByte bh (fromIntegral (fromEnum b))
get bh = do x <- getByte bh; pure $! (toEnum (fromIntegral x))
-- | The information stored in one AST node.
--
-- The type parameter exists to provide flexibility in representation of types
......@@ -314,7 +350,7 @@ instance Monoid (IdentifierDetails a) where
instance Binary (IdentifierDetails TypeIndex) where
put_ bh dets = do
put_ bh $ identType dets
put_ bh $ S.toAscList $ identInfo dets
put_ bh $ S.toList $ identInfo dets
get bh = IdentifierDetails
<$> get bh
<*> fmap S.fromDistinctAscList (get bh)
......@@ -363,6 +399,14 @@ data ContextInfo
-- | Record field
| RecField RecFieldContext (Maybe Span)
-- | Constraint/Dictionary evidence variable binding
| EvidenceVarBind
EvVarSource -- ^ how did this bind come into being
Scope -- ^ scope over which the value is bound
(Maybe Span) -- ^ span of the binding site
-- | Usage of evidence variable
| EvidenceVarUse
deriving (Eq, Ord)
instance Outputable ContextInfo where
......@@ -385,10 +429,16 @@ instance Outputable ContextInfo where
<+> ppr sc1 <+> "," <+> ppr sc2
ppr (RecField ctx sp) =
text "record field" <+> ppr ctx <+> pprBindSpan sp
ppr (EvidenceVarBind ctx sc sp) =
text "evidence variable" <+> ppr ctx
$$ "with scope:" <+> ppr sc
$$ pprBindSpan sp
ppr (EvidenceVarUse) =
text "usage of evidence variable"
pprBindSpan :: Maybe Span -> SDoc
pprBindSpan Nothing = text ""
pprBindSpan (Just sp) = text "at:" <+> ppr sp
pprBindSpan (Just sp) = text "bound at:" <+> ppr sp
instance Binary ContextInfo where
put_ bh Use = putByte bh 0
......@@ -422,6 +472,12 @@ instance Binary ContextInfo where
put_ bh a
put_ bh b
put_ bh MatchBind = putByte bh 9
put_ bh (EvidenceVarBind a b c) = do
putByte bh 10
put_ bh a
put_ bh b
put_ bh c
put_ bh EvidenceVarUse = putByte bh 11
get bh = do
(t :: Word8) <- get bh
......@@ -436,8 +492,69 @@ instance Binary ContextInfo where
7 -> TyVarBind <$> get bh <*> get bh
8 -> RecField <$> get bh <*> get bh
9 -> return MatchBind
10 -> EvidenceVarBind <$> get bh <*> get bh <*> get bh
11 -> return EvidenceVarUse
_ -> panic "Binary ContextInfo: invalid tag"
data EvVarSource
= EvPatternBind -- ^ bound by a pattern match
| EvSigBind -- ^ bound by a type signature
| EvWrapperBind -- ^ bound by a hswrapper
| EvImplicitBind -- ^ bound by an implicit variable
| EvInstBind { isSuperInst :: Bool, cls :: Name } -- ^ Bound by some instance of given class
| EvLetBind EvBindDeps -- ^ A direct let binding
deriving (Eq,Ord)
instance Binary EvVarSource where
put_ bh EvPatternBind = putByte bh 0
put_ bh EvSigBind = putByte bh 1
put_ bh EvWrapperBind = putByte bh 2
put_ bh EvImplicitBind = putByte bh 3
put_ bh (EvInstBind b cls) = do
putByte bh 4
put_ bh b
put_ bh cls
put_ bh (EvLetBind deps) = do
putByte bh 5
put_ bh deps
get bh = do
(t :: Word8) <- get bh
case t of
0 -> pure EvPatternBind
1 -> pure EvSigBind
2 -> pure EvWrapperBind
3 -> pure EvImplicitBind
4 -> EvInstBind <$> get bh <*> get bh
5 -> EvLetBind <$> get bh
_ -> panic "Binary EvVarSource: invalid tag"
instance Outputable EvVarSource where
ppr EvPatternBind = text "bound by a pattern"
ppr EvSigBind = text "bound by a type signature"
ppr EvWrapperBind = text "bound by a HsWrapper"
ppr EvImplicitBind = text "bound by an implicit variable binding"
ppr (EvInstBind False cls) = text "bound by an instance of class" <+> ppr cls
ppr (EvInstBind True cls) = text "bound due to a superclass of " <+> ppr cls
ppr (EvLetBind deps) = text "bound by a let, depending on:" <+> ppr deps
-- | Eq/Ord instances compare on the converted HieName,
-- as non-exported names may have different uniques after
-- a roundtrip
newtype EvBindDeps = EvBindDeps { getEvBindDeps :: [Name] }
deriving Outputable
instance Eq EvBindDeps where
(==) = coerce ((==) `on` map toHieName)
instance Ord EvBindDeps where
compare = coerce (compare `on` map toHieName)
instance Binary EvBindDeps where
put_ bh (EvBindDeps xs) = put_ bh xs
get bh = EvBindDeps <$> get bh
-- | Types of imports and exports
data IEType
= Import
......@@ -587,3 +704,46 @@ instance Binary TyVarScope where
0 -> ResolvedScopes <$> get bh
1 -> UnresolvedScope <$> get bh <*> get bh
_ -> panic "Binary TyVarScope: invalid tag"
-- | `Name`'s get converted into `HieName`'s before being written into @.hie@
-- files. See 'toHieName' and 'fromHieName' for logic on how to convert between
-- these two types.
data HieName
= ExternalName !Module !OccName !SrcSpan
| LocalName !OccName !SrcSpan
| KnownKeyName !Unique
deriving (Eq)
instance Ord HieName where
compare (ExternalName a b c) (ExternalName d e f) = compare (a,b) (d,e) `thenCmp` leftmost_smallest c f
-- TODO (int-index): Perhaps use RealSrcSpan in HieName?
compare (LocalName a b) (LocalName c d) = compare a c `thenCmp` leftmost_smallest b d
-- TODO (int-index): Perhaps use RealSrcSpan in HieName?
compare (KnownKeyName a) (KnownKeyName b) = nonDetCmpUnique a b
-- Not actually non deterministic as it is a KnownKey
compare ExternalName{} _ = LT
compare LocalName{} ExternalName{} = GT
compare LocalName{} _ = LT
compare KnownKeyName{} _ = GT
instance Outputable HieName where
ppr (ExternalName m n sp) = text "ExternalName" <+> ppr m <+> ppr n <+> ppr sp
ppr (LocalName n sp) = text "LocalName" <+> ppr n <+> ppr sp
ppr (KnownKeyName u) = text "KnownKeyName" <+> ppr u
hieNameOcc :: HieName -> OccName
hieNameOcc (ExternalName _ occ _) = occ
hieNameOcc (LocalName occ _) = occ
hieNameOcc (KnownKeyName u) =
case lookupKnownKeyName u of
Just n -> nameOccName n
Nothing -> pprPanic "hieNameOcc:unknown known-key unique"
(ppr (unpkUnique u))
toHieName :: Name -> HieName
toHieName name
| isKnownKeyName name = KnownKeyName (nameUnique name)
| isExternalName name = ExternalName (nameModule name)
(nameOccName name)
(nameSrcSpan name)
| otherwise = LocalName (nameOccName name) (nameSrcSpan name)
This diff is collapsed.
{-# 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{..}
......
{-# 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
==========================
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
......@@ -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))
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'])
Subproject commit 97f301a63ea8461074bfaa1486eb798e4be65f15
Subproject commit e4ae9d93befbae5b1d244cc828c2567f213f33b8
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment