mirror of
https://github.com/github/semantic.git
synced 2024-12-23 23:11:50 +03:00
Rework control flow graph data types
This commit is contained in:
Timothy Clem
parent
e3f20f6903
commit
f0d164f952
@ -82,8 +82,7 @@ library
|
||||
, Data.Functor.Both
|
||||
, Data.Functor.Classes.Generic
|
||||
, Data.Graph
|
||||
, Data.Graph.Adjacency
|
||||
, Data.Graph.Vertex
|
||||
, Data.Graph.ControlFlowVertex
|
||||
, Data.History
|
||||
, Data.JSON.Fields
|
||||
, Data.Language
|
||||
|
||||
@ -1,7 +1,7 @@
|
||||
{-# LANGUAGE ScopedTypeVariables, TypeFamilies, TypeOperators #-}
|
||||
module Analysis.Abstract.Graph
|
||||
( Graph(..)
|
||||
, Vertex(..)
|
||||
, ControlFlowVertex(..)
|
||||
, moduleVertex
|
||||
, unknownModuleVertex
|
||||
, style
|
||||
@ -28,14 +28,14 @@ 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.Graph.ControlFlowVertex
|
||||
import Data.Record
|
||||
import Data.Term
|
||||
import qualified Data.Map as Map
|
||||
import qualified Data.Text.Encoding as T
|
||||
import Prologue hiding (project)
|
||||
|
||||
style :: Style Vertex Builder
|
||||
style :: Style ControlFlowVertex Builder
|
||||
style = (defaultStyle (T.encodeUtf8Builder . vertexIdentifier))
|
||||
{ vertexAttributes = vertexAttributes
|
||||
, edgeAttributes = edgeAttributes
|
||||
@ -65,11 +65,11 @@ style = (defaultStyle (T.encodeUtf8Builder . vertexIdentifier))
|
||||
graphingTerms :: ( Member (Reader ModuleInfo) effects
|
||||
, Member (Reader Span) effects
|
||||
, Member (Env (Hole context (Located address))) effects
|
||||
, Member (State (Graph Vertex)) effects
|
||||
, Member (State (Map (Hole context (Located address)) Vertex)) effects
|
||||
, Member (State (Graph ControlFlowVertex)) effects
|
||||
, Member (State (Map (Hole context (Located address)) ControlFlowVertex)) effects
|
||||
, Member (Resumable (BaseError (EnvironmentError (Hole context (Located address))))) effects
|
||||
, AbstractValue (Hole context (Located address)) value effects
|
||||
, Member (Reader Vertex) effects
|
||||
, Member (Reader ControlFlowVertex) effects
|
||||
, HasField fields Span
|
||||
, VertexDeclaration syntax
|
||||
, Declarations1 syntax
|
||||
@ -108,8 +108,8 @@ graphingTerms recur term@(In a syntax) = do
|
||||
|
||||
-- | 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
|
||||
, Member (State (Graph ControlFlowVertex)) effects
|
||||
, Member (Reader ControlFlowVertex) effects
|
||||
)
|
||||
=> SubtermAlgebra Module term (TermEvaluator term address value effects a)
|
||||
-> SubtermAlgebra Module term (TermEvaluator term address value effects a)
|
||||
@ -120,8 +120,8 @@ graphingPackages recur m =
|
||||
graphingModules :: forall term address value effects a
|
||||
. ( Member (Modules address) effects
|
||||
, Member (Reader ModuleInfo) effects
|
||||
, Member (State (Graph Vertex)) effects
|
||||
, Member (Reader Vertex) effects
|
||||
, Member (State (Graph ControlFlowVertex)) effects
|
||||
, Member (Reader ControlFlowVertex) effects
|
||||
, PureEffects effects
|
||||
)
|
||||
=> SubtermAlgebra Module term (TermEvaluator term address value effects a)
|
||||
@ -160,10 +160,10 @@ graphingModuleInfo recur m = do
|
||||
-- | Add an edge from the current package to the passed vertex.
|
||||
packageInclusion :: ( Effectful m
|
||||
, Member (Reader PackageInfo) effects
|
||||
, Member (State (Graph Vertex)) effects
|
||||
, Member (State (Graph ControlFlowVertex)) effects
|
||||
, Monad (m effects)
|
||||
)
|
||||
=> Vertex
|
||||
=> ControlFlowVertex
|
||||
-> m effects ()
|
||||
packageInclusion v = do
|
||||
p <- currentPackage
|
||||
@ -172,20 +172,20 @@ packageInclusion v = do
|
||||
-- | Add an edge from the current module to the passed vertex.
|
||||
moduleInclusion :: ( Effectful m
|
||||
, Member (Reader ModuleInfo) effects
|
||||
, Member (State (Graph Vertex)) effects
|
||||
, Member (State (Graph ControlFlowVertex)) effects
|
||||
, Monad (m effects)
|
||||
)
|
||||
=> Vertex
|
||||
=> ControlFlowVertex
|
||||
-> m effects ()
|
||||
moduleInclusion v = do
|
||||
m <- currentModule
|
||||
appendGraph (vertex (moduleVertex m) `connect` vertex v)
|
||||
|
||||
-- | Add an edge from the passed variable name to the context it originated within.
|
||||
variableDefinition :: ( Member (State (Graph Vertex)) effects
|
||||
, Member (Reader Vertex) effects
|
||||
variableDefinition :: ( Member (State (Graph ControlFlowVertex)) effects
|
||||
, Member (Reader ControlFlowVertex) effects
|
||||
)
|
||||
=> Vertex
|
||||
=> ControlFlowVertex
|
||||
-> TermEvaluator term (Hole context (Located address)) value effects ()
|
||||
variableDefinition var = do
|
||||
context <- ask
|
||||
@ -195,6 +195,6 @@ appendGraph :: (Effectful m, Member (State (Graph v)) effects) => Graph v -> m e
|
||||
appendGraph = modify' . (<>)
|
||||
|
||||
|
||||
graphing :: (Effectful m, Effects effects, Functor (m (State (Graph Vertex) : effects)))
|
||||
=> m (State (Map (Hole context (Located address)) Vertex) ': State (Graph Vertex) ': effects) result -> m effects (Graph Vertex, result)
|
||||
graphing :: (Effectful m, Effects effects, Functor (m (State (Graph ControlFlowVertex) : effects)))
|
||||
=> m (State (Map (Hole context (Located address)) ControlFlowVertex) ': State (Graph ControlFlowVertex) ': effects) result -> m effects (Graph ControlFlowVertex, result)
|
||||
graphing = runState mempty . fmap snd . runState lowerBound
|
||||
|
||||
@ -7,18 +7,22 @@ module Data.Graph
|
||||
, Lower(..)
|
||||
, simplify
|
||||
, topologicalSort
|
||||
, JSONVertex(..)
|
||||
, VertexTag(..)
|
||||
, Edge(..)
|
||||
, vertexList
|
||||
, edgeList
|
||||
) where
|
||||
|
||||
import Prologue
|
||||
|
||||
import qualified Algebra.Graph as G
|
||||
import qualified Algebra.Graph.AdjacencyMap as A
|
||||
import Algebra.Graph.Class (connect, overlay, vertex)
|
||||
import Algebra.Graph.Class (connect, overlay, vertex)
|
||||
import qualified Algebra.Graph.Class as Class
|
||||
import Control.Monad.Effect
|
||||
import Control.Monad.Effect.State
|
||||
import Data.Aeson
|
||||
import Control.Monad.Effect
|
||||
import Control.Monad.Effect.State
|
||||
import Data.Aeson
|
||||
import qualified Data.Set as Set
|
||||
import Prologue
|
||||
|
||||
-- | An algebraic graph with 'Ord', 'Semigroup', and 'Monoid' instances.
|
||||
newtype Graph vertex = Graph { unGraph :: G.Graph vertex }
|
||||
@ -79,10 +83,16 @@ extendVisited f (Visited a b) = Visited (f a) b
|
||||
extendOrder :: ([v] -> [v]) -> Visited v -> Visited v
|
||||
extendOrder f (Visited a b) = Visited a (f b)
|
||||
|
||||
|
||||
toAdjacencyMap :: Ord v => G.Graph v -> A.AdjacencyMap v
|
||||
toAdjacencyMap = Class.toGraph
|
||||
|
||||
vertexList :: Ord v => Graph v -> [v]
|
||||
vertexList = G.vertexList . unGraph
|
||||
|
||||
edgeList :: Ord v => Graph v -> [Edge v]
|
||||
edgeList = fmap Edge . G.edgeList . unGraph
|
||||
|
||||
-- Instances
|
||||
|
||||
instance Lower (Graph vertex) where
|
||||
lowerBound = Class.empty
|
||||
@ -107,15 +117,15 @@ instance Ord vertex => Ord (Graph vertex) where
|
||||
compare (Graph (G.Connect a1 a2)) (Graph (G.Connect b1 b2)) = (compare `on` Graph) a1 b1 <> (compare `on` Graph) a2 b2
|
||||
|
||||
|
||||
class JSONVertex vertex where
|
||||
jsonVertexId :: vertex -> Text
|
||||
class VertexTag vertex where
|
||||
uniqueTag :: vertex -> Text
|
||||
|
||||
instance (Ord vertex, ToJSON vertex, JSONVertex vertex) => ToJSON (Graph vertex) where
|
||||
toJSON (Graph graph) = object ["vertices" .= G.vertexList graph, "edges" .= (JSONEdge <$> G.edgeList graph)]
|
||||
toEncoding (Graph graph) = pairs ("vertices" .= G.vertexList graph <> "edges" .= (JSONEdge <$> G.edgeList graph))
|
||||
instance (Ord vertex, ToJSON vertex, VertexTag vertex) => ToJSON (Graph vertex) where
|
||||
toJSON (Graph graph) = object ["vertices" .= G.vertexList graph, "edges" .= (Edge <$> G.edgeList graph)]
|
||||
toEncoding (Graph graph) = pairs ("vertices" .= G.vertexList graph <> "edges" .= (Edge <$> G.edgeList graph))
|
||||
|
||||
newtype JSONEdge vertex = JSONEdge (vertex, vertex)
|
||||
newtype Edge vertex = Edge (vertex, vertex)
|
||||
|
||||
instance (ToJSON vertex, JSONVertex vertex) => ToJSON (JSONEdge vertex) where
|
||||
toJSON (JSONEdge (a, b)) = object ["source" .= jsonVertexId a, "target" .= jsonVertexId b]
|
||||
toEncoding (JSONEdge (a, b)) = pairs ("source" .= jsonVertexId a <> "target" .= jsonVertexId b)
|
||||
instance (ToJSON vertex, VertexTag vertex) => ToJSON (Edge vertex) where
|
||||
toJSON (Edge (a, b)) = object ["source" .= uniqueTag a, "target" .= uniqueTag b]
|
||||
toEncoding (Edge (a, b)) = pairs ("source" .= uniqueTag a <> "target" .= uniqueTag b)
|
||||
|
||||
@ -1,178 +0,0 @@
|
||||
{-# LANGUAGE DeriveAnyClass, LambdaCase, ScopedTypeVariables #-}
|
||||
|
||||
module Data.Graph.Adjacency
|
||||
( AdjacencyList (..)
|
||||
, Edge (..)
|
||||
, Tag
|
||||
, Vertex (..)
|
||||
, VertexType (..)
|
||||
, graphToAdjacencyList
|
||||
, importGraphToGraph
|
||||
, tagGraph
|
||||
, isCoherent
|
||||
) where
|
||||
|
||||
import Prologue
|
||||
|
||||
import Algebra.Graph.AdjacencyMap (adjacencyMap)
|
||||
import Algebra.Graph.Class (ToGraph (..), edges, vertices)
|
||||
import Control.Monad.Effect
|
||||
import Control.Monad.Effect.State
|
||||
import Control.Monad.Effect.Fresh
|
||||
import Data.Aeson
|
||||
import Data.Coerce
|
||||
import Data.HashMap.Strict (HashMap, (!))
|
||||
import qualified Data.HashMap.Strict as HashMap
|
||||
import Data.HashSet (HashSet)
|
||||
import qualified Data.HashSet as HashSet
|
||||
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)
|
||||
import qualified Proto3.Suite as PB
|
||||
|
||||
import Data.Graph
|
||||
import qualified Data.Graph.Vertex as V
|
||||
|
||||
-- | Sum type corresponding to a protobuf enum for vertex types.
|
||||
data VertexType
|
||||
= PACKAGE
|
||||
| MODULE
|
||||
| UNKNOWN_MODULE
|
||||
| VARIABLE
|
||||
| METHOD
|
||||
| FUNCTION
|
||||
deriving (Eq, Ord, Show, Enum, Bounded, Generic, ToJSON, FromJSON, PB.Named, PB.Finite, PB.MessageField)
|
||||
|
||||
-- | Defaults to 'PACKAGE'.
|
||||
instance PB.HasDefault VertexType where def = PACKAGE
|
||||
|
||||
-- | Piggybacks on top of the 'Enumerated' instance, as the generated code would.
|
||||
-- This instance will get easier when we have DerivingVia, or a Generic instance
|
||||
-- that hooks into Enumerated.
|
||||
instance PB.Primitive VertexType where
|
||||
primType _ = PB.primType (Proxy @(PB.Enumerated VertexType))
|
||||
encodePrimitive f = PB.encodePrimitive f . PB.Enumerated . Right
|
||||
decodePrimitive = PB.decodePrimitive >>= \case
|
||||
(PB.Enumerated (Right r)) -> pure r
|
||||
other -> Prelude.fail ("VertexType decodeMessageField: unexpected value" <> show other)
|
||||
|
||||
-- | A tag used on each vertext of a 'Graph' to convert to an 'AdjacencyList'.
|
||||
type Tag = Word64
|
||||
|
||||
-- | A protobuf-compatible vertex type, with a unique 'Tag' identifier.
|
||||
data Vertex = Vertex
|
||||
{ vertexType :: VertexType
|
||||
, vertexContents :: Text
|
||||
, vertexTag :: Tag
|
||||
} deriving (Eq, Ord, Show, Generic, PB.Message, PB.Named)
|
||||
|
||||
-- | A protobuf-compatible edge type. Only tag information is carried;
|
||||
-- consumers are expected to look up nodes in the vertex list when necessary.
|
||||
data Edge = Edge { edgeFrom :: Tag, edgeTo :: Tag }
|
||||
deriving (Eq, Ord, Show, Generic, Hashable, PB.Named, PB.Message)
|
||||
|
||||
-- | An adjacency list-representation of a graph. You generally build these by calling
|
||||
-- 'graphToAdjacencyList' on an algebraic 'Graph'. This representation is less efficient and
|
||||
-- fluent than an ordinary 'Graph', but is more amenable to serialization.
|
||||
data AdjacencyList = AdjacencyList
|
||||
{ graphVertices :: PB.NestedVec Vertex
|
||||
, graphEdges :: PB.NestedVec Edge
|
||||
} deriving (Eq, Ord, Show, Generic, PB.Named, PB.Message)
|
||||
|
||||
-- | Convert an algebraic graph to an adjacency list.
|
||||
graphToAdjacencyList :: Graph V.Vertex -> AdjacencyList
|
||||
graphToAdjacencyList = taggedGraphToAdjacencyList . tagGraph . simplify
|
||||
|
||||
-- * Internal interface stuff
|
||||
|
||||
-- Using a PBGraph as the accumulator for the fold would incur
|
||||
-- significant overhead associated with Vector concatenation.
|
||||
-- We use this and then pay the O(v + e) to-Vector cost once.
|
||||
-- The fields are strict because we have StrictData on.
|
||||
data Acc = Acc [Vertex] (HashSet Edge)
|
||||
|
||||
-- Convert a graph with tagged members to a protobuf-compatible adjacency list.
|
||||
-- The Tag is necessary to build a canonical adjacency list.
|
||||
-- Since import graphs can be very large, this is written with speed in mind, in
|
||||
-- that we convert the graph to algebraic-graphs's 'AdjacencyMap' and then fold
|
||||
-- to build a 'Graph', avoiding inefficient vector concatenation.
|
||||
-- Time complexity, given V vertices and E edges, is at least O(2V + 2E + (V * E * log E)),
|
||||
-- plus whatever overhead converting the graph to 'AdjacencyMap' may entail.
|
||||
taggedGraphToAdjacencyList :: Graph (V.Vertex, Tag) -> AdjacencyList
|
||||
taggedGraphToAdjacencyList = accumToAdj . adjMapToAccum . adjacencyMap . toGraph . simplify
|
||||
where adjMapToAccum :: Map (V.Vertex, Tag) (Set (V.Vertex, Tag)) -> Acc
|
||||
adjMapToAccum = Map.foldlWithKey go (Acc [] mempty)
|
||||
|
||||
go :: Acc -> (V.Vertex, Tag) -> Set (V.Vertex, Tag) -> Acc
|
||||
go (Acc vs es) (v, from) edges = Acc (vertexToPB v from : vs) (Set.foldr' (add . snd) es edges)
|
||||
where add = HashSet.insert . Edge from
|
||||
|
||||
accumToAdj :: Acc -> AdjacencyList
|
||||
accumToAdj (Acc vs es) = AdjacencyList (fromList vs) (fromList (toList es))
|
||||
|
||||
vertexToPB :: V.Vertex -> Tag -> Vertex
|
||||
vertexToPB s = Vertex t (V.vertexIdentifier s) where
|
||||
t = case s of
|
||||
V.Package{} -> PACKAGE
|
||||
V.Module{} -> MODULE
|
||||
V.UnknownModule{} -> UNKNOWN_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@.
|
||||
tagGraph :: forall a . (Eq a, Hashable a) => Graph a -> Graph (a, Tag)
|
||||
tagGraph = unwrap . traverse go where
|
||||
|
||||
unwrap :: Eff '[Fresh, State (HashMap a Tag)] (Graph (a, Tag)) -> Graph (a, Tag)
|
||||
unwrap = run . fmap snd . runState HashMap.empty . runFresh 1
|
||||
|
||||
go :: a -> Eff '[Fresh, State (HashMap a Tag)] (a, Tag)
|
||||
go v = gets (HashMap.lookup v) >>= \case
|
||||
Just t -> pure (v, t)
|
||||
Nothing -> do
|
||||
next <- fromIntegral <$> fresh
|
||||
modify' (HashMap.insert v next)
|
||||
pure (v, next)
|
||||
|
||||
-- | This is the reverse of 'graphToAdjacencyList'. Don't use this outside of a testing context.
|
||||
-- N.B. @importGraphToGraph . graphToAdjacencyList@ is 'id', but @graphToAdjacencyList . importGraphToGraph@ is not.
|
||||
importGraphToGraph :: AdjacencyList -> Graph V.Vertex
|
||||
importGraphToGraph (AdjacencyList vs es) = simplify built
|
||||
where built = allEdges <> vertices unreferencedVertices
|
||||
|
||||
allEdges :: Graph V.Vertex
|
||||
allEdges = fmap fst (edges (foldr addEdge [] es))
|
||||
addEdge (Edge f t) xs = ((adjMap ! f, f), (adjMap ! t, t)) : xs
|
||||
adjMap = foldMap (\v -> HashMap.singleton (vertexTag v) (pbToVertex v)) vs
|
||||
|
||||
unreferencedVertices :: [V.Vertex]
|
||||
unreferencedVertices = pbToVertex <$> toList (Vec.filter isUnreferenced (coerce vs))
|
||||
|
||||
isUnreferenced :: Vertex -> Bool
|
||||
isUnreferenced v = not (vertexTag v `HashSet.member` edgedTags)
|
||||
|
||||
edgedTags :: HashSet Tag
|
||||
edgedTags = HashSet.fromList $ concatMap unEdge es where unEdge (Edge f t) = [f, t]
|
||||
|
||||
pbToVertex :: Vertex -> V.Vertex
|
||||
pbToVertex (Vertex t c _) = case t of
|
||||
PACKAGE -> V.Package c
|
||||
MODULE -> V.Module c
|
||||
UNKNOWN_MODULE -> V.UnknownModule 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.
|
||||
isCoherent :: AdjacencyList -> Bool
|
||||
isCoherent (AdjacencyList vs es) = all edgeValid es where
|
||||
edgeValid (Edge a b) = HashSet.member a allTags && HashSet.member b allTags
|
||||
allTags = HashSet.fromList (toList (vertexTag <$> vs))
|
||||
238
src/Data/Graph/ControlFlowVertex.hs
Normal file
238
src/Data/Graph/ControlFlowVertex.hs
Normal file
@ -0,0 +1,238 @@
|
||||
{-# LANGUAGE DeriveAnyClass, ScopedTypeVariables, TypeFamilies, TypeOperators, UndecidableInstances #-}
|
||||
module Data.Graph.ControlFlowVertex
|
||||
( ControlFlowVertex (..)
|
||||
, packageVertex
|
||||
, moduleVertex
|
||||
, unknownModuleVertex
|
||||
, variableVertex
|
||||
, methodVertex
|
||||
, functionVertex
|
||||
, vertexIdentifier
|
||||
, 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 Data.Graph (VertexTag(..))
|
||||
import qualified Data.Graph as G
|
||||
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 Prologue hiding (packageName)
|
||||
|
||||
-- import Data.Word
|
||||
import Proto3.Suite
|
||||
import qualified Proto3.Suite as PB
|
||||
import qualified Proto3.Suite.Types as PB
|
||||
import qualified Proto3.Wire.Encode as Encode
|
||||
import qualified Proto3.Wire.Decode as Decode
|
||||
import qualified Algebra.Graph as Graph
|
||||
import GHC.Exts (fromList)
|
||||
|
||||
-- | A vertex of representing some node in a control flow graph.
|
||||
data ControlFlowVertex
|
||||
= Package { vertexName :: Text }
|
||||
| Module { vertexName :: Text }
|
||||
| UnknownModule { vertexName :: Text }
|
||||
| Variable { vertexName :: Text, vertexModuleName :: Text, vertexSpan :: Span }
|
||||
| Method { vertexName :: Text, vertexModuleName :: Text, vertexSpan :: Span }
|
||||
| Function { vertexName :: Text, vertexModuleName :: Text, vertexSpan :: Span }
|
||||
deriving (Eq, Ord, Show, Generic, Hashable, Named)
|
||||
|
||||
-- | A tag used on each vertex of a 'Graph' to convert to an 'ControlFlowAdjacencyList'.
|
||||
-- type Tag = Word64
|
||||
|
||||
-- -- | A serializable edge type for control flow graphs. Only tag information is
|
||||
-- -- carried about vertices; consumers are expected to look up nodes in the vertex
|
||||
-- -- list when necessary.
|
||||
-- data ControlFlowEdge = ControlFlowEdge
|
||||
-- { controlFlowEdgeFrom :: Tag
|
||||
-- , controlFlowEdgeTo :: Tag
|
||||
-- } deriving (Eq, Ord, Show, Generic, Hashable, PB.Named, Message)
|
||||
|
||||
-- -- | An adjacency list-representation of a control flow graph. This
|
||||
-- -- representation is less efficient and fluent than an ordinary 'Graph', but is
|
||||
-- -- more amenable to serialization.
|
||||
-- data ControlFlowAdjacencyList = ControlFlowAdjacencyList
|
||||
-- { controlFlowVertices :: [ControlFlowVertex]
|
||||
-- , controlFlowEdges :: [ControlFlowEdge]
|
||||
-- } deriving (Eq, Ord, Show, Generic, Hashable, Named, Message)
|
||||
|
||||
|
||||
packageVertex :: PackageInfo -> ControlFlowVertex
|
||||
packageVertex (PackageInfo name _) = Package (formatName name)
|
||||
|
||||
moduleVertex :: ModuleInfo -> ControlFlowVertex
|
||||
moduleVertex = Module . T.pack . modulePath
|
||||
|
||||
unknownModuleVertex :: ModuleInfo -> ControlFlowVertex
|
||||
unknownModuleVertex = UnknownModule . T.pack . modulePath
|
||||
|
||||
variableVertex :: Text -> ModuleInfo -> Span -> ControlFlowVertex
|
||||
variableVertex name ModuleInfo{..} = Variable name (T.pack modulePath)
|
||||
|
||||
methodVertex :: Text -> ModuleInfo -> Span -> ControlFlowVertex
|
||||
methodVertex name ModuleInfo{..} = Method name (T.pack modulePath)
|
||||
|
||||
functionVertex :: Text -> ModuleInfo -> Span -> ControlFlowVertex
|
||||
functionVertex name ModuleInfo{..} = Function name (T.pack modulePath)
|
||||
|
||||
vertexIdentifier :: ControlFlowVertex -> Text
|
||||
vertexIdentifier v@Package{..} = vertexName <> " (" <> vertexToType v <> ")"
|
||||
vertexIdentifier v@Module{..} = vertexName <> " (" <> vertexToType v <> ")"
|
||||
vertexIdentifier v@UnknownModule{..} = vertexName <> " (" <> vertexToType v <> ")"
|
||||
vertexIdentifier v = vertexModuleName v <> "::" <> vertexName v <> " (" <> vertexToType v <> " " <> showSpan (vertexSpan v) <> ")"
|
||||
|
||||
showSpan :: Span -> Text
|
||||
showSpan (Span (Pos a b) (Pos c d)) = T.pack $
|
||||
"[" <> show a <> ", " <> show b <> "]"
|
||||
<> " - "
|
||||
<> "[" <> show c <> ", " <> show d <> "]"
|
||||
|
||||
vertexToType :: ControlFlowVertex -> Text
|
||||
vertexToType Package{} = "Package"
|
||||
vertexToType Module{} = "Module"
|
||||
vertexToType UnknownModule{} = "Unknown Module"
|
||||
vertexToType Variable{} = "Variable"
|
||||
vertexToType Method{} = "Method"
|
||||
vertexToType Function{} = "Function"
|
||||
|
||||
|
||||
-- Instances
|
||||
|
||||
instance Named (G.Graph ControlFlowVertex) where nameOf _ = "ControlFlowGraph"
|
||||
|
||||
instance Message (G.Graph ControlFlowVertex) where
|
||||
encodeMessage _ graph = encodeMessageField 1 (NestedVec (fromList (G.vertexList graph)))
|
||||
<> encodeMessageField 2 (NestedVec (fromList (G.edgeList graph)))
|
||||
decodeMessage = undefined
|
||||
dotProto _ =
|
||||
[ DotProtoMessageField $ DotProtoField 1 (Repeated . Named $ Single "ControlFlowVertex") (Single "vertices") [] Nothing
|
||||
, DotProtoMessageField $ DotProtoField 2 (Repeated . Named $ Single "ControlFlowEdge") (Single "edges") [] Nothing
|
||||
]
|
||||
|
||||
instance Lower ControlFlowVertex where lowerBound = Package ""
|
||||
instance VertexTag ControlFlowVertex where uniqueTag = vertexIdentifier
|
||||
|
||||
instance ToJSON ControlFlowVertex where
|
||||
toJSON v = object [ "name" .= vertexIdentifier v, "type" .= vertexToType v ]
|
||||
|
||||
instance Message ControlFlowVertex where
|
||||
encodeMessage _ v@Package{..} = Encode.embedded 1 (encodePrimitive 1 (vertexIdentifier v) <> encodePrimitive 2 vertexName)
|
||||
encodeMessage _ v@Module{..} = Encode.embedded 2 (encodePrimitive 1 (vertexIdentifier v) <> encodePrimitive 2 vertexName)
|
||||
encodeMessage _ v@UnknownModule{..} = Encode.embedded 3 (encodePrimitive 1 (vertexIdentifier v) <> encodePrimitive 2 vertexName)
|
||||
encodeMessage _ v@Variable{..} = Encode.embedded 4 (encodePrimitive 1 (vertexIdentifier v) <> encodePrimitive 2 vertexName <> encodePrimitive 3 vertexModuleName <> encodeMessage 4 vertexSpan)
|
||||
encodeMessage _ v@Method{..} = Encode.embedded 5 (encodePrimitive 1 (vertexIdentifier v) <> encodePrimitive 2 vertexName <> encodePrimitive 3 vertexModuleName <> encodeMessage 4 vertexSpan)
|
||||
encodeMessage _ v@Function{..} = Encode.embedded 6 (encodePrimitive 1 (vertexIdentifier v) <> encodePrimitive 2 vertexName <> encodePrimitive 3 vertexModuleName <> encodeMessage 4 vertexSpan)
|
||||
decodeMessage = undefined
|
||||
dotProto _ =
|
||||
[ DotProtoMessageOneOf (Single "vertex")
|
||||
[ DotProtoField 1 (Prim . Named $ Single "Package") (Single "package") [] Nothing
|
||||
, DotProtoField 2 (Prim . Named $ Single "Module") (Single "module") [] Nothing
|
||||
, DotProtoField 3 (Prim . Named $ Single "UnknownModule") (Single "unknownModule") [] Nothing
|
||||
, DotProtoField 4 (Prim . Named $ Single "Variable") (Single "variable") [] Nothing
|
||||
, DotProtoField 5 (Prim . Named $ Single "Method") (Single "method") [] Nothing
|
||||
, DotProtoField 6 (Prim . Named $ Single "Function") (Single "function") [] Nothing
|
||||
]
|
||||
]
|
||||
<> gen "Package" mempty
|
||||
<> gen "Module" mempty
|
||||
<> gen "UnknownModule" mempty
|
||||
<> gen "Variable" [ genModuleName, genSpan ]
|
||||
<> gen "Method" [ genModuleName, genSpan ]
|
||||
<> gen "Function" [ genModuleName, genSpan ]
|
||||
where
|
||||
genModuleName = DotProtoMessageField $ DotProtoField 3 (Prim PB.String) (Single "moduleName") [] Nothing
|
||||
genSpan = DotProtoMessageField $ DotProtoField 4 (Prim . Named $ Single (nameOf (Proxy @Span))) (Single "span") [] Nothing
|
||||
gen name extras =
|
||||
[ DotProtoMessageDefinition . DotProtoMessage (Single name) $
|
||||
(DotProtoMessageField $ DotProtoField 1 (Prim PB.String) (Single "id") [] Nothing)
|
||||
: (DotProtoMessageField $ DotProtoField 2 (Prim PB.String) (Single "name") [] Nothing)
|
||||
: extras
|
||||
]
|
||||
|
||||
|
||||
instance Named (G.Edge ControlFlowVertex) where nameOf _ = "ControlFlowEdge"
|
||||
|
||||
instance Message (G.Edge ControlFlowVertex) where
|
||||
encodeMessage _ (G.Edge (from, to)) = encodePrimitive 1 (uniqueTag from) <> encodePrimitive 2 (uniqueTag to)
|
||||
decodeMessage = undefined
|
||||
dotProto _ =
|
||||
[ DotProtoMessageField $ DotProtoField 1 (Prim PB.String) (Single "from") [] Nothing
|
||||
, DotProtoMessageField $ DotProtoField 2 (Prim PB.String) (Single "to") [] Nothing
|
||||
]
|
||||
|
||||
|
||||
-- Typeclasses to create 'ControlFlowVertex's from 'Term's. Also extracts
|
||||
-- 'Name's for terms with symbolic names like Identifiers and Declarations.
|
||||
|
||||
class VertexDeclaration syntax where
|
||||
toVertex :: (Declarations1 syntax, Foldable syntax, HasField fields Span)
|
||||
=> Record fields
|
||||
-> ModuleInfo
|
||||
-> syntax (Term syntax (Record fields))
|
||||
-> Maybe (ControlFlowVertex, 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 (ControlFlowVertex, 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 (ControlFlowVertex, 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)
|
||||
@ -1,148 +0,0 @@
|
||||
{-# LANGUAGE DeriveAnyClass, ScopedTypeVariables, TypeFamilies, TypeOperators, UndecidableInstances #-}
|
||||
module Data.Graph.Vertex
|
||||
( Vertex (..)
|
||||
, packageVertex
|
||||
, moduleVertex
|
||||
, unknownModuleVertex
|
||||
, variableVertex
|
||||
, methodVertex
|
||||
, functionVertex
|
||||
, vertexIdentifier
|
||||
, 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 Data.Graph (JSONVertex(..))
|
||||
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 Prologue hiding (packageName)
|
||||
|
||||
-- | A vertex of some specific type.
|
||||
data Vertex
|
||||
= Package { vertexName :: Text }
|
||||
| Module { vertexName :: Text }
|
||||
| UnknownModule { vertexName :: Text }
|
||||
| Variable { vertexName :: Text, vertexModuleName :: Text, vertexSpan :: Span }
|
||||
| Method { vertexName :: Text, vertexModuleName :: Text, vertexSpan :: Span }
|
||||
| Function { vertexName :: Text, vertexModuleName :: Text, vertexSpan :: Span }
|
||||
deriving (Eq, Ord, Show, Generic, Hashable)
|
||||
|
||||
packageVertex :: PackageInfo -> Vertex
|
||||
packageVertex (PackageInfo name _) = Package (formatName name)
|
||||
|
||||
moduleVertex :: ModuleInfo -> Vertex
|
||||
moduleVertex = Module . T.pack . modulePath
|
||||
|
||||
unknownModuleVertex :: ModuleInfo -> Vertex
|
||||
unknownModuleVertex = UnknownModule . 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" .= vertexIdentifier v, "type" .= vertexToType v ]
|
||||
|
||||
vertexIdentifier :: Vertex -> Text
|
||||
vertexIdentifier v@Package{..} = vertexName <> " (" <> vertexToType v <> ")"
|
||||
vertexIdentifier v@Module{..} = vertexName <> " (" <> vertexToType v <> ")"
|
||||
vertexIdentifier v@UnknownModule{..} = vertexName <> " (" <> vertexToType v <> ")"
|
||||
vertexIdentifier v = vertexModuleName v <> "::" <> vertexName v <> " (" <> vertexToType v <> " " <> showSpan (vertexSpan v) <> ")"
|
||||
|
||||
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 UnknownModule{} = "Unknown Module"
|
||||
vertexToType Variable{} = "Variable"
|
||||
vertexToType Method{} = "Method"
|
||||
vertexToType Function{} = "Function"
|
||||
|
||||
instance Lower Vertex where
|
||||
lowerBound = Package ""
|
||||
|
||||
instance JSONVertex Vertex where
|
||||
jsonVertexId = vertexIdentifier
|
||||
|
||||
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)
|
||||
@ -33,7 +33,7 @@ import qualified Assigning.Assignment.Deterministic as Deterministic
|
||||
import qualified CMarkGFM
|
||||
import Data.Abstract.Evaluatable (HasPostlude, HasPrelude)
|
||||
import Data.AST
|
||||
import Data.Graph.Vertex (VertexDeclaration')
|
||||
import Data.Graph.ControlFlowVertex (VertexDeclaration')
|
||||
import Data.Kind
|
||||
import Data.Language
|
||||
import Data.Record
|
||||
|
||||
@ -137,8 +137,8 @@ instance ToJSON TermVertex where
|
||||
<> toJSONFields vertexSpan ))
|
||||
|
||||
|
||||
instance JSONVertex TermVertex where
|
||||
jsonVertexId = T.pack . show . vertexId
|
||||
instance VertexTag TermVertex where
|
||||
uniqueTag = T.pack . show . vertexId
|
||||
|
||||
instance ToJSON DiffVertex where
|
||||
toJSON (DiffVertex i (Deleted t)) = object [ "id" .= T.pack (show i), "deleted" .= t ]
|
||||
@ -149,8 +149,8 @@ instance ToJSON DiffVertex where
|
||||
-- toEncoding = undefined
|
||||
|
||||
|
||||
instance JSONVertex DiffVertex where
|
||||
jsonVertexId = T.pack . show . diffVertexId
|
||||
instance VertexTag DiffVertex where
|
||||
uniqueTag = T.pack . show . diffVertexId
|
||||
|
||||
|
||||
class ToTreeGraph vertex t | t -> vertex where
|
||||
|
||||
@ -7,7 +7,7 @@ module Semantic.Graph
|
||||
, runImportGraphToModuleInfos
|
||||
, GraphType(..)
|
||||
, Graph
|
||||
, Vertex
|
||||
, ControlFlowVertex
|
||||
, ConcreteEff(..)
|
||||
, style
|
||||
, parsePackage
|
||||
@ -47,7 +47,7 @@ import Data.Abstract.Value.Type as Type
|
||||
import Data.Blob
|
||||
import Data.Coerce
|
||||
import Data.Graph
|
||||
import Data.Graph.Vertex (VertexDeclarationStrategy, VertexDeclarationWithStrategy)
|
||||
import Data.Graph.ControlFlowVertex (VertexDeclarationStrategy, VertexDeclarationWithStrategy)
|
||||
import Data.Language as Language
|
||||
import Data.List (isPrefixOf, isSuffixOf)
|
||||
import Data.Project
|
||||
@ -70,7 +70,7 @@ runGraph :: forall effs. (Member Distribute effs, Member (Exc SomeException) eff
|
||||
=> GraphType
|
||||
-> Bool
|
||||
-> Project
|
||||
-> Eff effs (Graph Vertex)
|
||||
-> Eff effs (Graph ControlFlowVertex)
|
||||
runGraph ImportGraph _ project
|
||||
| SomeAnalysisParser parser (lang' :: Proxy lang) <- someAnalysisParser (Proxy :: Proxy AnalysisClasses) (projectLanguage project) = do
|
||||
let parse = if projectLanguage project == Language.Python then parsePythonPackage parser else fmap (fmap snd) . parsePackage parser
|
||||
@ -103,7 +103,7 @@ runCallGraph :: ( HasField fields Span
|
||||
-> Bool
|
||||
-> [Module term]
|
||||
-> Package term
|
||||
-> Eff effs (Graph Vertex)
|
||||
-> Eff effs (Graph ControlFlowVertex)
|
||||
runCallGraph lang includePackages modules package = do
|
||||
let analyzeTerm = withTermSpans . graphingTerms . cachingTerms
|
||||
analyzeModule = (if includePackages then graphingPackages else id) . convergingModules . graphingModules
|
||||
@ -122,7 +122,7 @@ runCallGraph lang includePackages modules package = do
|
||||
. resumingAddressError
|
||||
. runReader (packageInfo package)
|
||||
. runReader (lowerBound @Span)
|
||||
. runReader (lowerBound @Vertex)
|
||||
. runReader (lowerBound @ControlFlowVertex)
|
||||
. providingLiveSet
|
||||
. runReader (lowerBound @(ModuleTable (NonEmpty (Module (ModuleResult (Hole (Maybe Name) (Located Monovariant)))))))
|
||||
. raiseHandler (runModules (ModuleTable.modulePaths (packageModules package)))
|
||||
@ -142,7 +142,7 @@ runImportGraphToModuleInfos :: ( Declarations term
|
||||
)
|
||||
=> Proxy lang
|
||||
-> Package term
|
||||
-> Eff effs (Graph Vertex)
|
||||
-> Eff effs (Graph ControlFlowVertex)
|
||||
runImportGraphToModuleInfos lang (package :: Package term) = runImportGraph lang package allModuleInfos
|
||||
where allModuleInfos info = maybe (vertex (unknownModuleVertex info)) (foldMap (vertex . moduleVertex . moduleInfo)) (ModuleTable.lookup (modulePath info) (packageModules package))
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user