github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-01 00:33:59 +03:00
Code Issues Projects Releases Wiki Activity

Merge pull request #2070 from github/vertex++

Browse Source 
Structured information in Vertex
This commit is contained in:
Timothy Clem 2018-07-20 08:00:49 -07:00 committed by GitHub
commit 89ca32661e
6 changed files with 214 additions and 72 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

98
src/Analysis/Abstract/Graph.hs
View File

@ -18,14 +18,13 @@ module Analysis.Abstract.Graph
import Algebra.Graph.Export.Dot hiding (vertexName)
import Control.Abstract
import Data.Abstract.Address
import Data.Abstract.Module (Module(moduleInfo), ModuleInfo(..))
import Data.Abstract.Name
import Data.Abstract.Package (PackageInfo(..))
import Data.Abstract.Declarations
import Data.Abstract.Module (Module (moduleInfo), ModuleInfo (..))
import Data.Abstract.Package (PackageInfo (..))
import Data.ByteString.Builder
import Data.Graph
import Data.Graph.Vertex
import Data.Sum
import qualified Data.Syntax as Syntax
import Data.Record
import Data.Term
import qualified Data.Text.Encoding as T
import Prologue hiding (project)
@ -35,39 +34,62 @@ style = (defaultStyle (T.encodeUtf8Builder . vertexName))
{ vertexAttributes = vertexAttributes
, edgeAttributes = edgeAttributes
}
where vertexAttributes Package{} = [ "style" := "dashed", "shape" := "box" ]
vertexAttributes Module{} = [ "style" := "dotted, rounded", "shape" := "box" ]
vertexAttributes Variable{} = []
edgeAttributes Package{} Module{} = [ "style" := "dashed" ]
edgeAttributes Module{} Variable{} = [ "style" := "dotted" ]
edgeAttributes Variable{} Module{} = [ "color" := "blue" ]
where vertexAttributes Package{} = [ "style" := "dashed", "shape" := "box" ]
vertexAttributes Module{} = [ "style" := "dotted, rounded", "shape" := "box" ]
vertexAttributes Variable{..} = [ "tooltip" := T.encodeUtf8Builder (showSpan variableSpan), "style" := "rounded", "shape" := "box" ]
vertexAttributes Method{..} = [ "tooltip" := T.encodeUtf8Builder (showSpan methodSpan) , "style" := "rounded", "shape" := "box" ]
vertexAttributes Function{..} = [ "tooltip" := T.encodeUtf8Builder (showSpan functionSpan), "style" := "rounded", "shape" := "box" ]
edgeAttributes Package{} Module{} = [ "len" := "5.0", "style" := "dashed" ]
edgeAttributes Module{} Module{} = [ "len" := "5.0", "label" := "imports" ]
edgeAttributes Variable{} Module{} = [ "len" := "5.0", "color" := "blue", "label" := "refers to symbol defined in" ]
edgeAttributes _ Module{} = [ "len" := "5.0", "color" := "blue", "label" := "defined in" ]
edgeAttributes Method{} Variable{} = [ "len" := "2.0", "color" := "green", "label" := "calls" ]
edgeAttributes Function{} Variable{} = [ "len" := "2.0", "color" := "green", "label" := "calls" ]
edgeAttributes Module{} Function{} = [ "len" := "2.0", "color" := "red", "label" := "defines" ]
edgeAttributes Module{} Method{} = [ "len" := "2.0", "color" := "red", "label" := "defines" ]
edgeAttributes Module{} _ = [ "len" := "2.0", "color" := "green", "label" := "calls" ]
edgeAttributes _ _ = []
-- | Add vertices to the graph for evaluated identifiers.
graphingTerms :: ( Element Syntax.Identifier syntax
, Member (Reader ModuleInfo) effects
graphingTerms :: ( Member (Reader ModuleInfo) effects
, Member (Env (Hole context (Located address))) effects
, Member (State (Graph Vertex)) effects
, Base term ~ TermF (Sum syntax) ann
, Member (Reader Vertex) effects
, HasField fields Span
, VertexDeclaration syntax
, Declarations1 syntax
, Foldable syntax
, Functor syntax
, term ~ Term syntax (Record fields)
)
=> SubtermAlgebra (Base term) term (TermEvaluator term (Hole context (Located address)) value effects a)
-> SubtermAlgebra (Base term) term (TermEvaluator term (Hole context (Located address)) value effects a)
graphingTerms recur term@(In _ syntax) = do
case project syntax of
Just (Syntax.Identifier name) -> do
moduleInclusion (Variable (formatName name))
variableDefinition name
_ -> pure ()
recur term
graphingTerms recur term@(In a syntax) = do
definedInModule <- currentModule
case toVertex a definedInModule (subterm <$> syntax) of
Just (v@Function{}, _) -> recurWithContext v
Just (v@Method{}, _) -> recurWithContext v
Just (Variable{..}, name) -> do
definedInModuleInfo <- maybe (ModuleInfo "unknown") (maybe (ModuleInfo "hole") addressModule . toMaybe) <$> TermEvaluator (lookupEnv name)
variableDefinition (variableVertex variableName definedInModuleInfo variableSpan)
recur term
_ -> recur term
where
recurWithContext v = do
variableDefinition v
moduleInclusion v
local (const v) (recur term)
-- | Add vertices to the graph for evaluated modules and the packages containing them.
graphingPackages :: ( Member (Reader PackageInfo) effects
, Member (State (Graph Vertex)) effects
, Member (Reader Vertex) effects
)
=> SubtermAlgebra Module term (TermEvaluator term address value effects a)
-> SubtermAlgebra Module term (TermEvaluator term address value effects a)
graphingPackages recur m = packageInclusion (moduleVertex (moduleInfo m)) *> recur m
graphingPackages recur m =
let v = moduleVertex (moduleInfo m) in packageInclusion v *> local (const v) (recur m)
-- | Add vertices to the graph for imported modules.
graphingModules :: forall term address value effects a
@ -75,16 +97,20 @@ graphingModules :: forall term address value effects a
, Member (Modules address) effects
, Member (Reader ModuleInfo) effects
, Member (State (Graph Vertex)) effects
, Member (Reader Vertex) effects
)
=> SubtermAlgebra Module term (TermEvaluator term address value effects a)
-> SubtermAlgebra Module term (TermEvaluator term address value effects a)
graphingModules recur m = do
appendGraph (vertex (moduleVertex (moduleInfo m)))
eavesdrop @(Modules address) (\ m -> case m of
Load path -> moduleInclusion (moduleVertex (ModuleInfo path))
Lookup path -> moduleInclusion (moduleVertex (ModuleInfo path))
_ -> pure ())
(recur m)
let v = moduleVertex (moduleInfo m)
appendGraph (vertex v)
local (const v) $
eavesdrop @(Modules address) (\ m -> case m of
-- NB: path is null for Languages like Ruby that have module imports that require concrete value semantics.
Load path | not (Prologue.null path) -> moduleInclusion (moduleVertex (ModuleInfo path))
Lookup path | not (Prologue.null path) -> moduleInclusion (moduleVertex (ModuleInfo path))
_ -> pure ())
(recur m)
-- | Add vertices to the graph for imported modules.
graphingModuleInfo :: forall term address value effects a
@ -98,7 +124,7 @@ graphingModuleInfo :: forall term address value effects a
graphingModuleInfo recur m = do
appendGraph (vertex (moduleInfo m))
eavesdrop @(Modules address) (\ eff -> case eff of
Load path -> currentModule >>= appendGraph . (`connect` vertex (ModuleInfo path)) . vertex
Load path -> currentModule >>= appendGraph . (`connect` vertex (ModuleInfo path)) . vertex
Lookup path -> currentModule >>= appendGraph . (`connect` vertex (ModuleInfo path)) . vertex
_ -> pure ())
(recur m)
@ -127,15 +153,15 @@ moduleInclusion v = do
m <- currentModule
appendGraph (vertex (moduleVertex m) `connect` vertex v)
-- | Add an edge from the passed variable name to the module it originated within.
variableDefinition :: ( Member (Env (Hole context (Located address))) effects
, Member (State (Graph Vertex)) effects
-- | Add an edge from the passed variable name to the context it originated within.
variableDefinition :: ( Member (State (Graph Vertex)) effects
, Member (Reader Vertex) effects
)
=> Name
=> Vertex
-> TermEvaluator term (Hole context (Located address)) value effects ()
variableDefinition name = do
graph <- maybe lowerBound (maybe lowerBound (vertex . moduleVertex . addressModule) . toMaybe) <$> TermEvaluator (lookupEnv name)
appendGraph (vertex (Variable (formatName name)) `connect` graph)
variableDefinition var = do
context <- ask
appendGraph $ vertex context `connect` vertex var
appendGraph :: (Effectful m, Member (State (Graph v)) effects) => Graph v -> m effects ()
appendGraph = modify' . (<>)

9
src/Data/Graph/Adjacency.hs
View File

@ -29,6 +29,7 @@ import Data.Map (Map)
import qualified Data.Map as Map
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Span
import qualified Data.Vector as Vec
import Data.Word
import GHC.Exts (fromList)
@ -42,6 +43,8 @@ data VertexType
= PACKAGE
| MODULE
| VARIABLE
| METHOD
| FUNCTION
deriving (Eq, Ord, Show, Enum, Bounded, Generic, ToJSON, FromJSON, PB.Named, PB.Finite, PB.MessageField)
-- | Defaults to 'PACKAGE'.
@ -117,6 +120,8 @@ taggedGraphToAdjacencyList = accumToAdj . adjMapToAccum . adjacencyMap . toGraph
V.Package{} -> PACKAGE
V.Module{} -> MODULE
V.Variable{} -> VARIABLE
V.Method{} -> METHOD
V.Function{} -> FUNCTION
-- Annotate all vertices of a 'Graph' with a 'Tag', starting from 1.
-- Two vertices @a@ and @b@ will share a 'Tag' iff @a == b@.
@ -158,7 +163,9 @@ importGraphToGraph (AdjacencyList vs es) = simplify built
pbToVertex (Vertex t c _) = case t of
MODULE -> V.Module c
PACKAGE -> V.Package c
VARIABLE -> V.Variable c
VARIABLE -> V.Variable c "unknown" emptySpan
METHOD -> V.Method c "unknown" emptySpan
FUNCTION -> V.Function c "unknown" emptySpan
-- | For debugging: returns True if all edges reference a valid vertex tag.

134
src/Data/Graph/Vertex.hs
View File

@ -1,37 +1,139 @@
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveAnyClass, ScopedTypeVariables, TypeFamilies, TypeOperators, UndecidableInstances #-}
module Data.Graph.Vertex
( Vertex (..)
, moduleVertex
, packageVertex
, vertexToType
) where
import Prologue
( Vertex (..)
, packageVertex
, moduleVertex
, variableVertex
, methodVertex
, functionVertex
, vertexName
, showSpan
, VertexDeclaration (..)
, VertexDeclaration' (..)
, VertexDeclarationStrategy
, VertexDeclarationWithStrategy
) where
import Data.Abstract.Declarations
import Data.Abstract.Module (ModuleInfo (..))
import Data.Abstract.Name
import Data.Abstract.Package (PackageInfo (..))
import Data.Aeson
import Data.Record
import Data.Span
import qualified Data.Syntax as Syntax
import qualified Data.Syntax.Declaration as Declaration
import qualified Data.Syntax.Expression as Expression
import Data.Term
import qualified Data.Text as T
import Data.Abstract.Module (ModuleInfo (..))
import Data.Abstract.Name
import Data.Abstract.Package hiding (Package (Package))
import Prologue hiding (packageName)
-- | A vertex of some specific type.
data Vertex
= Package { vertexName :: Text }
| Module { vertexName :: Text }
| Variable { vertexName :: Text }
= Package { packageName :: Text }
| Module { moduleName :: Text }
| Variable { variableName :: Text, variableModuleName :: Text, variableSpan :: Span }
| Method { methodName :: Text, methodModuleName :: Text, methodSpan :: Span }
| Function { functionName :: Text, functionModuleName :: Text, functionSpan :: Span }
deriving (Eq, Ord, Show, Generic, Hashable)
packageVertex :: PackageInfo -> Vertex
packageVertex = Package . formatName . Data.Abstract.Package.packageName
packageVertex (PackageInfo name _) = Package (formatName name)
moduleVertex :: ModuleInfo -> Vertex
moduleVertex = Module . T.pack . modulePath
variableVertex :: Text -> ModuleInfo -> Span -> Vertex
variableVertex name ModuleInfo{..} = Variable name (T.pack modulePath)
methodVertex :: Text -> ModuleInfo -> Span -> Vertex
methodVertex name ModuleInfo{..} = Method name (T.pack modulePath)
functionVertex :: Text -> ModuleInfo -> Span -> Vertex
functionVertex name ModuleInfo{..} = Function name (T.pack modulePath)
instance ToJSON Vertex where
toJSON v = object [ "name" .= vertexName v, "type" .= vertexToType v ]
vertexName :: Vertex -> Text
vertexName Package{..} = packageName <> " (Package)"
vertexName Module{..} = moduleName <> " (Module)"
vertexName Variable{..} = variableModuleName <> "::" <> variableName <> " (Variable)"
vertexName Method{..} = methodModuleName <> "::" <> methodName <> " (Method)"
vertexName Function{..} = functionModuleName <> "::" <> functionName <> " (Function)"
showSpan :: Span -> Text
showSpan (Span (Pos a b) (Pos c d)) = T.pack $
"[" <> show a <> ", " <> show b <> "]"
<> " - "
<> "[" <> show c <> ", " <> show d <> "]"
vertexToType :: Vertex -> Text
vertexToType Package{} = "package"
vertexToType Module{} = "module"
vertexToType Variable{} = "variable"
vertexToType Method{} = "method"
vertexToType Function{} = "function"
instance Lower Vertex where
lowerBound = Package ""
class VertexDeclaration syntax where
toVertex :: (Declarations1 syntax, Foldable syntax, HasField fields Span)
=> Record fields
-> ModuleInfo
-> syntax (Term syntax (Record fields))
-> Maybe (Vertex, Name)
instance (VertexDeclaration' syntax syntax) => VertexDeclaration syntax where
toVertex = toVertex'
class VertexDeclaration' whole syntax where
toVertex' :: (Declarations1 whole, Foldable whole, HasField fields Span)
=> Record fields
-> ModuleInfo
-> syntax (Term whole (Record fields))
-> Maybe (Vertex, Name)
instance (VertexDeclarationStrategy syntax ~ strategy, VertexDeclarationWithStrategy strategy whole syntax) => VertexDeclaration' whole syntax where
toVertex' = toVertexWithStrategy (Proxy :: Proxy strategy)
data Strategy = Default | Custom
type family VertexDeclarationStrategy syntax where
VertexDeclarationStrategy Syntax.Identifier = 'Custom
VertexDeclarationStrategy Declaration.Function = 'Custom
VertexDeclarationStrategy Declaration.Method = 'Custom
VertexDeclarationStrategy Expression.MemberAccess = 'Custom
VertexDeclarationStrategy (Sum _) = 'Custom
VertexDeclarationStrategy syntax = 'Default
class VertexDeclarationWithStrategy (strategy :: Strategy) whole syntax where
toVertexWithStrategy :: (Declarations1 whole, Foldable whole, HasField fields Span)
=> proxy strategy
-> Record fields
-> ModuleInfo
-> syntax (Term whole (Record fields))
-> Maybe (Vertex, Name)
-- | The 'Default' strategy produces 'Nothing'.
instance VertexDeclarationWithStrategy 'Default whole syntax where
toVertexWithStrategy _ _ _ _ = Nothing
instance Apply (VertexDeclaration' whole) fs => VertexDeclarationWithStrategy 'Custom whole (Sum fs) where
toVertexWithStrategy _ ann info = apply @(VertexDeclaration' whole) (toVertex' ann info)
instance VertexDeclarationWithStrategy 'Custom whole Syntax.Identifier where
toVertexWithStrategy _ ann info (Syntax.Identifier name) = Just (variableVertex (formatName name) info (getField ann), name)
instance VertexDeclarationWithStrategy 'Custom whole Declaration.Function where
toVertexWithStrategy _ ann info term@Declaration.Function{} = (\n -> (functionVertex (formatName n) info (getField ann), n)) <$> liftDeclaredName declaredName term
instance VertexDeclarationWithStrategy 'Custom whole Declaration.Method where
toVertexWithStrategy _ ann info term@Declaration.Method{} = (\n -> (methodVertex (formatName n) info (getField ann), n)) <$> liftDeclaredName declaredName term
instance VertexDeclarationWithStrategy 'Custom whole whole => VertexDeclarationWithStrategy 'Custom whole Expression.MemberAccess where
toVertexWithStrategy proxy ann info (Expression.MemberAccess (Term (In lhsAnn lhs)) name) =
case toVertexWithStrategy proxy lhsAnn info lhs of
Just (Variable n _ _, _) -> Just (variableVertex (n <> "." <> formatName name) info (getField ann), name)
_ -> Just (variableVertex (formatName name) info (getField ann), name)

8
src/Parsing/Parser.hs
View File

@ -29,8 +29,9 @@ module Parsing.Parser
import Assigning.Assignment
import qualified Assigning.Assignment.Deterministic as Deterministic
import qualified CMarkGFM
import Data.Abstract.Evaluatable (HasPrelude, HasPostlude)
import Data.Abstract.Evaluatable (HasPostlude, HasPrelude)
import Data.AST
import Data.Graph.Vertex (VertexDeclaration')
import Data.Kind
import Data.Language
import Data.Record
@ -49,14 +50,14 @@ import qualified Language.Ruby.Assignment as Ruby
import qualified Language.TypeScript.Assignment as TypeScript
import Prologue
import TreeSitter.Go
import TreeSitter.Haskell
import TreeSitter.Java
import TreeSitter.JSON
import qualified TreeSitter.Language as TS (Language, Symbol)
import TreeSitter.Java
import TreeSitter.PHP
import TreeSitter.Python
import TreeSitter.Ruby
import TreeSitter.TypeScript
import TreeSitter.Haskell
type family ApplyAll' (typeclasses :: [(* -> *) -> Constraint]) (fs :: [* -> *]) :: Constraint where
@ -66,6 +67,7 @@ type family ApplyAll' (typeclasses :: [(* -> *) -> Constraint]) (fs :: [* -> *])
-- | A parser, suitable for program analysis, for some specific language, producing 'Term's whose syntax satisfies a list of typeclass constraints.
data SomeAnalysisParser typeclasses ann where
SomeAnalysisParser :: ( ApplyAll' typeclasses fs
, Apply (VertexDeclaration' (Sum fs)) fs
, Element Syntax.Identifier fs
, HasPrelude lang
, HasPostlude lang

23
src/Semantic/Graph.hs
View File

@ -33,12 +33,12 @@ import Data.Abstract.Module
import qualified Data.Abstract.ModuleTable as ModuleTable
import Data.Abstract.Package as Package
import Data.Abstract.Value.Abstract
import Data.Abstract.Value.Concrete (Value, ValueError (..), runValueErrorWith)
import Data.Abstract.Value.Type
import Data.Abstract.Value.Concrete (Value,ValueError (..), runValueErrorWith)
import Data.Graph
import Data.Graph.Vertex (VertexDeclarationStrategy, VertexDeclarationWithStrategy)
import Data.Project
import Data.Record
import qualified Data.Syntax as Syntax
import Data.Term
import Data.Text (pack)
import Language.Haskell.HsColour
@ -67,18 +67,20 @@ runGraph CallGraph includePackages project
modules <- topologicalSort <$> runImportGraph lang package
runCallGraph lang includePackages modules package
runCallGraph :: ( HasField ann Span
, Element Syntax.Identifier syntax
, Base term ~ TermF (Sum syntax) (Record ann)
, Ord term
, Corecursive term
, Declarations term
, Evaluatable (Base term)
runCallGraph :: ( HasField fields Span
, Show (Record fields)
, Ord (Record fields)
, (VertexDeclarationWithStrategy (VertexDeclarationStrategy syntax) syntax syntax)
, Declarations1 syntax
, Ord1 syntax
, Functor syntax
, Evaluatable syntax
, term ~ Term syntax (Record fields)
, FreeVariables term
, Recursive term
, HasPrelude lang
, HasPostlude lang
, Member Trace effs
, Recursive term
, Effects effs
)
=> Proxy lang
@ -104,6 +106,7 @@ runCallGraph lang includePackages modules package = do
. resumingAddressError
. runReader (packageInfo package)
. runReader (lowerBound @Span)
. runReader (lowerBound @Vertex)
. providingLiveSet
. runReader (lowerBound @(ModuleTable (NonEmpty (Module (Environment (Hole (Maybe Name) (Located Monovariant)), Hole (Maybe Name) (Located Monovariant))))))
. raiseHandler (runModules (ModuleTable.modulePaths (packageModules package)))

14
test/Graphing/Calls/Spec.hs
View File

@ -9,8 +9,10 @@ import SpecHelpers hiding (readFile)
import Algebra.Graph
import Data.List (uncons)
import Data.Abstract.Module
import "semantic" Data.Graph (Graph (..), topologicalSort)
import Data.Graph.Vertex
import Data.Span
import qualified Data.Language as Language
import Semantic.Config (defaultOptions)
import Semantic.Graph
@ -27,21 +29,21 @@ callGraphPythonProject paths = runTaskWithOptions defaultOptions $ do
spec :: Spec
spec = describe "call graphing" $ do
let needs r n = unGraph r `shouldSatisfy` hasVertex (Variable n)
let needs r v = unGraph r `shouldSatisfy` hasVertex v
it "should work for a simple example" $ do
res <- callGraphPythonProject ["test/fixtures/python/graphing/simple/simple.py"]
res `needs` "magnus"
res `needs` Variable "magnus" "simple.py" (Span (Pos 4 1) (Pos 4 7))
it "should evaluate both sides of an if-statement" $ do
res <- callGraphPythonProject ["test/fixtures/python/graphing/conditional/conditional.py"]
res `needs` "merle"
res `needs` "taako"
res `needs` Variable "merle" "conditional.py" (Span (Pos 5 5) (Pos 5 10))
res `needs` Variable "taako" "conditional.py" (Span (Pos 8 5) (Pos 8 10))
it "should continue even when a type error is encountered" $ do
res <- callGraphPythonProject ["test/fixtures/python/graphing/typeerror/typeerror.py"]
res `needs` "lup"
res `needs` Variable "lup" "typeerror.py" (Span (Pos 5 1) (Pos 5 4))
it "should continue when an unbound variable is encountered" $ do
res <- callGraphPythonProject ["test/fixtures/python/graphing/unbound/unbound.py"]
res `needs` "lucretia"
res `needs` Variable "lucretia" "unbound.py" (Span (Pos 5 1) (Pos 5 9))