mirror of
https://github.com/github/semantic.git
synced 2024-11-23 16:37:50 +03:00
Merge branch 'master' into codegen-migration-leftovers
This commit is contained in:
Ayman Nadeem
commit
d94cef94c5
@ -44,6 +44,8 @@ function flags {
|
||||
then add_autogen_includes "$build_dir/semantic-0.10.0.0/noopt/build/autogen"
|
||||
fi
|
||||
|
||||
echo "-optP-Wno-macro-redefined"
|
||||
|
||||
# .hs source dirs
|
||||
# TODO: would be nice to figure this out from cabal.project & the .cabal files
|
||||
echo "-isemantic-analysis/src"
|
||||
|
||||
@ -4,14 +4,14 @@ module Language.Python
|
||||
, Language.Python.Grammar.tree_sitter_python
|
||||
) where
|
||||
|
||||
import qualified AST.Unmarshal as TS
|
||||
import Data.Proxy
|
||||
import qualified Language.Python.AST as Py
|
||||
import qualified Language.Python.Grammar (tree_sitter_python)
|
||||
import Language.Python.ScopeGraph
|
||||
import qualified Language.Python.Tags as PyTags
|
||||
import ScopeGraph.Convert
|
||||
import Scope.Graph.Convert
|
||||
import qualified Tags.Tagging.Precise as Tags
|
||||
import qualified Language.Python.Grammar (tree_sitter_python)
|
||||
import qualified AST.Unmarshal as TS
|
||||
|
||||
newtype Term a = Term { getTerm :: Py.Module a }
|
||||
|
||||
|
||||
@ -24,7 +24,10 @@ module Language.Python.ScopeGraph
|
||||
import qualified Analysis.Name as Name
|
||||
import AST.Element
|
||||
import Control.Effect.Fresh
|
||||
import Control.Effect.Sketch
|
||||
import Control.Effect.ScopeGraph
|
||||
import qualified Control.Effect.ScopeGraph.Properties.Declaration as Props
|
||||
import qualified Control.Effect.ScopeGraph.Properties.Function as Props
|
||||
import qualified Control.Effect.ScopeGraph.Properties.Reference as Props
|
||||
import Control.Lens (set, (^.))
|
||||
import Data.Foldable
|
||||
import Data.Maybe
|
||||
@ -36,10 +39,7 @@ import GHC.Records
|
||||
import GHC.TypeLits
|
||||
import qualified Language.Python.AST as Py
|
||||
import Language.Python.Patterns
|
||||
import ScopeGraph.Convert (Result (..), complete, todo)
|
||||
import qualified ScopeGraph.Properties.Declaration as Props
|
||||
import qualified ScopeGraph.Properties.Function as Props
|
||||
import qualified ScopeGraph.Properties.Reference as Props
|
||||
import Scope.Graph.Convert (Result (..), complete, todo)
|
||||
import Source.Loc
|
||||
import Source.Span (span_)
|
||||
|
||||
@ -49,7 +49,7 @@ import Source.Span (span_)
|
||||
-- every single Python AST type.
|
||||
class (forall a . Show a => Show (t a)) => ToScopeGraph t where
|
||||
scopeGraph ::
|
||||
( Has Sketch sig m
|
||||
( Has ScopeGraph sig m
|
||||
, Monoid (m Result)
|
||||
)
|
||||
=> t Loc
|
||||
@ -61,7 +61,7 @@ instance (ToScopeGraph l, ToScopeGraph r) => ToScopeGraph (l :+: r) where
|
||||
|
||||
onField ::
|
||||
forall (field :: Symbol) syn sig m r .
|
||||
( Has Sketch sig m
|
||||
( Has ScopeGraph sig m
|
||||
, HasField field (r Loc) (syn Loc)
|
||||
, ToScopeGraph syn
|
||||
, Monoid (m Result)
|
||||
@ -75,7 +75,7 @@ onField
|
||||
onChildren ::
|
||||
( Traversable t
|
||||
, ToScopeGraph syn
|
||||
, Has Sketch sig m
|
||||
, Has ScopeGraph sig m
|
||||
, HasField "extraChildren" (r Loc) (t (syn Loc))
|
||||
, Monoid (m Result)
|
||||
)
|
||||
@ -86,7 +86,7 @@ onChildren
|
||||
. traverse scopeGraph
|
||||
. getField @"extraChildren"
|
||||
|
||||
scopeGraphModule :: Has Sketch sig m => Py.Module Loc -> m Result
|
||||
scopeGraphModule :: Has ScopeGraph sig m => Py.Module Loc -> m Result
|
||||
scopeGraphModule = getAp . scopeGraph
|
||||
|
||||
instance ToScopeGraph Py.AssertStatement where scopeGraph = onChildren
|
||||
@ -231,7 +231,13 @@ instance ToScopeGraph Py.Integer where scopeGraph = mempty
|
||||
|
||||
instance ToScopeGraph Py.ImportStatement where scopeGraph = todo
|
||||
|
||||
instance ToScopeGraph Py.ImportFromStatement where scopeGraph = todo
|
||||
instance ToScopeGraph Py.ImportFromStatement where
|
||||
scopeGraph (Py.ImportFromStatement _ [] (L1 (Py.DottedName _ names)) (Just (Py.WildcardImport _ _))) = do
|
||||
let toName (Py.Identifier _ name) = Name.name name
|
||||
complete <* insertEdge ScopeGraph.Import (toName <$> names)
|
||||
scopeGraph term = todo (show term)
|
||||
|
||||
|
||||
|
||||
instance ToScopeGraph Py.Lambda where scopeGraph = todo
|
||||
|
||||
|
||||
@ -7,19 +7,23 @@ module Main (main) where
|
||||
|
||||
import Analysis.Name (Name)
|
||||
import qualified Analysis.Name as Name
|
||||
import qualified AST.Unmarshal as TS
|
||||
import Control.Algebra
|
||||
import Control.Carrier.Lift
|
||||
import Control.Carrier.Sketch.Fresh
|
||||
import Control.Carrier.Sketch.ScopeGraph
|
||||
import Control.Effect.ScopeGraph
|
||||
import qualified Control.Effect.ScopeGraph.Properties.Declaration as Props
|
||||
import qualified Control.Effect.ScopeGraph.Properties.Function as Props
|
||||
import qualified Control.Effect.ScopeGraph.Properties.Reference as Props
|
||||
import Control.Monad
|
||||
import qualified Data.ByteString as ByteString
|
||||
import qualified Data.List.NonEmpty as NonEmpty
|
||||
import qualified Data.ScopeGraph as ScopeGraph
|
||||
import Data.Semilattice.Lower
|
||||
import qualified Language.Python ()
|
||||
import qualified Language.Python as Py (Term)
|
||||
import ScopeGraph.Convert
|
||||
import qualified ScopeGraph.Properties.Declaration as Props
|
||||
import qualified ScopeGraph.Properties.Function as Props
|
||||
import qualified ScopeGraph.Properties.Reference as Props
|
||||
import qualified Language.Python.Grammar as TSP
|
||||
import Scope.Graph.Convert
|
||||
import Source.Loc
|
||||
import qualified Source.Source as Source
|
||||
import Source.Span
|
||||
@ -29,8 +33,6 @@ import qualified System.Path as Path
|
||||
import qualified System.Path.Directory as Path
|
||||
import qualified Test.Tasty as Tasty
|
||||
import qualified Test.Tasty.HUnit as HUnit
|
||||
import qualified Language.Python.Grammar as TSP
|
||||
import qualified AST.Unmarshal as TS
|
||||
|
||||
{-
|
||||
|
||||
@ -56,7 +58,7 @@ The graph should be
|
||||
runScopeGraph :: ToScopeGraph t => Path.AbsRelFile -> Source.Source -> t Loc -> (ScopeGraph.ScopeGraph Name, Result)
|
||||
runScopeGraph p _src item = run . runSketch (Just p) $ scopeGraph item
|
||||
|
||||
sampleGraphThing :: (Has Sketch sig m) => m Result
|
||||
sampleGraphThing :: (Has ScopeGraph sig m) => m Result
|
||||
sampleGraphThing = do
|
||||
declare "hello" (Props.Declaration ScopeGraph.Assignment ScopeGraph.Default Nothing (Span (Pos 2 0) (Pos 2 10)))
|
||||
declare "goodbye" (Props.Declaration ScopeGraph.Assignment ScopeGraph.Default Nothing (Span (Pos 3 0) (Pos 3 12)))
|
||||
@ -77,7 +79,7 @@ assertSimpleAssignment = do
|
||||
(expecto, Complete) <- runM $ runSketch Nothing sampleGraphThing
|
||||
HUnit.assertEqual "Should work for simple case" expecto result
|
||||
|
||||
expectedReference :: (Has Sketch sig m) => m Result
|
||||
expectedReference :: (Has ScopeGraph sig m) => m Result
|
||||
expectedReference = do
|
||||
declare "x" (Props.Declaration ScopeGraph.Assignment ScopeGraph.Default Nothing (Span (Pos 0 0) (Pos 0 5)))
|
||||
reference "x" "x" Props.Reference
|
||||
@ -91,13 +93,13 @@ assertSimpleReference = do
|
||||
|
||||
HUnit.assertEqual "Should work for simple case" expecto result
|
||||
|
||||
expectedLexicalScope :: (Has Sketch sig m) => m Result
|
||||
expectedLexicalScope :: (Has ScopeGraph sig m) => m Result
|
||||
expectedLexicalScope = do
|
||||
_ <- declareFunction (Just $ Name.name "foo") (Props.Function ScopeGraph.Function (Span (Pos 0 0) (Pos 1 24)))
|
||||
reference "foo" "foo" Props.Reference {}
|
||||
pure Complete
|
||||
|
||||
expectedFunctionArg :: (Has Sketch sig m) => m Result
|
||||
expectedFunctionArg :: (Has ScopeGraph sig m) => m Result
|
||||
expectedFunctionArg = do
|
||||
(_, associatedScope) <- declareFunction (Just $ Name.name "foo") (Props.Function ScopeGraph.Function (Span (Pos 0 0) (Pos 1 12)))
|
||||
withScope associatedScope $ do
|
||||
@ -107,6 +109,11 @@ expectedFunctionArg = do
|
||||
reference "foo" "foo" Props.Reference
|
||||
pure Complete
|
||||
|
||||
expectedImportHole :: (Has ScopeGraph sig m) => m Result
|
||||
expectedImportHole = do
|
||||
insertEdge ScopeGraph.Import (NonEmpty.fromList ["cheese", "ints"])
|
||||
pure Complete
|
||||
|
||||
assertLexicalScope :: HUnit.Assertion
|
||||
assertLexicalScope = do
|
||||
let path = "semantic-python/test/fixtures/5-02-simple-function.py"
|
||||
@ -123,6 +130,14 @@ assertFunctionArg = do
|
||||
(expecto, Complete) -> HUnit.assertEqual "Should work for simple case" expecto graph
|
||||
(_, Todo msg) -> HUnit.assertFailure ("Failed to complete:" <> show msg)
|
||||
|
||||
assertImportHole :: HUnit.Assertion
|
||||
assertImportHole = do
|
||||
let path = "semantic-python/test/fixtures/cheese/6-01-imports.py"
|
||||
(graph, _) <- graphFile path
|
||||
case run (runSketch Nothing expectedImportHole) of
|
||||
(expecto, Complete) -> HUnit.assertEqual "Should work for simple case" expecto graph
|
||||
(_, Todo msg) -> HUnit.assertFailure ("Failed to complete:" <> show msg)
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
-- make sure we're in the root directory so the paths resolve properly
|
||||
@ -141,5 +156,8 @@ main = do
|
||||
Tasty.testGroup "lexical scopes" [
|
||||
HUnit.testCase "simple function scope" assertLexicalScope
|
||||
, HUnit.testCase "simple function argument" assertFunctionArg
|
||||
],
|
||||
Tasty.testGroup "imports" [
|
||||
HUnit.testCase "simple function argument" assertImportHole
|
||||
]
|
||||
]
|
||||
|
||||
1
semantic-python/test/fixtures/cheese/6-01-imports.py
vendored
Normal file
1
semantic-python/test/fixtures/cheese/6-01-imports.py
vendored
Normal file
@ -0,0 +1 @@
|
||||
from cheese.ints import *
|
||||
5
semantic-python/test/fixtures/cheese/ints.py
vendored
Normal file
5
semantic-python/test/fixtures/cheese/ints.py
vendored
Normal file
@ -0,0 +1,5 @@
|
||||
def one():
|
||||
return 1
|
||||
|
||||
def two():
|
||||
return 2
|
||||
@ -20,12 +20,18 @@ tested-with: GHC == 8.6.5
|
||||
|
||||
library
|
||||
exposed-modules:
|
||||
Control.Carrier.Sketch.Fresh
|
||||
Control.Effect.Sketch
|
||||
ScopeGraph.Convert
|
||||
ScopeGraph.Properties.Declaration
|
||||
ScopeGraph.Properties.Function
|
||||
ScopeGraph.Properties.Reference
|
||||
Control.Carrier.Sketch.ScopeGraph
|
||||
Control.Effect.ScopeGraph
|
||||
Control.Effect.ScopeGraph.Properties.Declaration
|
||||
Control.Effect.ScopeGraph.Properties.Function
|
||||
Control.Effect.ScopeGraph.Properties.Reference
|
||||
Scope.Graph.AdjacencyList
|
||||
Scope.Graph.Convert
|
||||
Scope.Info
|
||||
Scope.Path
|
||||
Scope.Reference
|
||||
Scope.Scope
|
||||
Scope.Types
|
||||
Data.Hole
|
||||
Data.Module
|
||||
Data.ScopeGraph
|
||||
|
||||
@ -13,10 +13,10 @@
|
||||
|
||||
-- | This carrier interprets the Sketch effect, keeping track of
|
||||
-- the current scope and in-progress graph internally.
|
||||
module Control.Carrier.Sketch.Fresh
|
||||
module Control.Carrier.Sketch.ScopeGraph
|
||||
( SketchC (..)
|
||||
, runSketch
|
||||
, module Control.Effect.Sketch
|
||||
, module Control.Effect.ScopeGraph
|
||||
) where
|
||||
|
||||
import Analysis.Name (Name)
|
||||
@ -25,14 +25,15 @@ import Control.Algebra
|
||||
import Control.Carrier.Fresh.Strict
|
||||
import Control.Carrier.Reader
|
||||
import Control.Carrier.State.Strict
|
||||
import Control.Effect.Sketch
|
||||
import Control.Effect.ScopeGraph (ScopeGraphEff (..))
|
||||
import qualified Control.Effect.ScopeGraph.Properties.Declaration as Props
|
||||
import Control.Monad.IO.Class
|
||||
import Data.Bifunctor
|
||||
import qualified Data.List.NonEmpty as NonEmpty
|
||||
import Data.Module
|
||||
import Data.ScopeGraph (ScopeGraph)
|
||||
import qualified Data.ScopeGraph as ScopeGraph
|
||||
import Data.Semilattice.Lower
|
||||
import qualified ScopeGraph.Properties.Declaration as Props
|
||||
import Source.Span
|
||||
import qualified System.Path as Path
|
||||
|
||||
@ -56,7 +57,7 @@ instance Lower Sketchbook where
|
||||
newtype SketchC address m a = SketchC (StateC Sketchbook (FreshC m) a)
|
||||
deriving (Applicative, Functor, Monad, MonadIO)
|
||||
|
||||
instance (Effect sig, Algebra sig m) => Algebra (SketchEff :+: Reader Name :+: Fresh :+: sig) (SketchC Name m) where
|
||||
instance (Effect sig, Algebra sig m) => Algebra (ScopeGraphEff :+: Reader Name :+: Fresh :+: sig) (SketchC Name m) where
|
||||
alg (L (Declare n props k)) = do
|
||||
Sketchbook old current <- SketchC (get @Sketchbook)
|
||||
let Props.Declaration kind relation associatedScope span = props
|
||||
@ -92,6 +93,12 @@ instance (Effect sig, Algebra sig m) => Algebra (SketchEff :+: Reader Name :+: F
|
||||
let new = ScopeGraph.newScope name edges old
|
||||
SketchC (put (Sketchbook new current))
|
||||
k name
|
||||
alg (L (InsertEdge label address k)) = do
|
||||
Sketchbook old current <- SketchC get
|
||||
let new = ScopeGraph.addImportEdge label (NonEmpty.toList address) current old
|
||||
SketchC (put (Sketchbook new current))
|
||||
k ()
|
||||
|
||||
alg (R (L a)) = case a of
|
||||
Ask k -> SketchC (gets sCurrentScope) >>= k
|
||||
Local fn go k -> do
|
||||
@ -8,15 +8,16 @@
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
|
||||
-- | The Sketch effect is used to build up a scope graph over
|
||||
-- | The ScopeGraph effect is used to build up a scope graph over
|
||||
-- the lifetime of a monadic computation. The name is meant to evoke
|
||||
-- physically sketching the hierarchical outline of a graph.
|
||||
module Control.Effect.Sketch
|
||||
( Sketch
|
||||
, SketchEff (..)
|
||||
module Control.Effect.ScopeGraph
|
||||
( ScopeGraph
|
||||
, ScopeGraphEff (..)
|
||||
, declare
|
||||
-- Scope Manipulation
|
||||
, currentScope
|
||||
, insertEdge
|
||||
, newScope
|
||||
, withScope
|
||||
, declareFunction
|
||||
@ -30,40 +31,47 @@ import qualified Analysis.Name as Name
|
||||
import Control.Algebra
|
||||
import Control.Effect.Fresh
|
||||
import Control.Effect.Reader
|
||||
import Data.List.NonEmpty
|
||||
import Data.Map.Strict (Map)
|
||||
import qualified Data.Map.Strict as Map
|
||||
import qualified Data.ScopeGraph as ScopeGraph
|
||||
import Data.Text (Text)
|
||||
import GHC.Generics (Generic, Generic1)
|
||||
import qualified ScopeGraph.Properties.Declaration as Props
|
||||
import qualified ScopeGraph.Properties.Function as Props
|
||||
import qualified ScopeGraph.Properties.Reference as Props
|
||||
|
||||
type Sketch
|
||||
= SketchEff
|
||||
import qualified Control.Effect.ScopeGraph.Properties.Declaration as Props
|
||||
import qualified Control.Effect.ScopeGraph.Properties.Function as Props
|
||||
import qualified Control.Effect.ScopeGraph.Properties.Reference as Props
|
||||
|
||||
type ScopeGraph
|
||||
= ScopeGraphEff
|
||||
:+: Fresh
|
||||
:+: Reader Name
|
||||
|
||||
data SketchEff m k =
|
||||
data ScopeGraphEff m k =
|
||||
Declare Name Props.Declaration (() -> m k)
|
||||
| Reference Text Text Props.Reference (() -> m k)
|
||||
| NewScope (Map ScopeGraph.EdgeLabel [Name]) (Name -> m k)
|
||||
| InsertEdge ScopeGraph.EdgeLabel (NonEmpty Name) (() -> m k)
|
||||
deriving (Generic, Generic1, HFunctor, Effect)
|
||||
|
||||
currentScope :: Has (Reader Name) sig m => m Name
|
||||
currentScope = ask
|
||||
|
||||
declare :: forall sig m . (Has Sketch sig m) => Name -> Props.Declaration -> m ()
|
||||
declare :: forall sig m . (Has ScopeGraph sig m) => Name -> Props.Declaration -> m ()
|
||||
declare n props = send (Declare n props pure)
|
||||
|
||||
-- | Establish a reference to a prior declaration.
|
||||
reference :: forall sig m . (Has Sketch sig m) => Text -> Text -> Props.Reference -> m ()
|
||||
reference :: forall sig m . (Has ScopeGraph sig m) => Text -> Text -> Props.Reference -> m ()
|
||||
reference n decl props = send (Reference n decl props pure)
|
||||
|
||||
newScope :: forall sig m . (Has Sketch sig m) => Map ScopeGraph.EdgeLabel [Name] -> m Name
|
||||
newScope :: forall sig m . Has ScopeGraph sig m => Map ScopeGraph.EdgeLabel [Name] -> m Name
|
||||
newScope edges = send (NewScope edges pure)
|
||||
|
||||
declareFunction :: forall sig m . (Has Sketch sig m) => Maybe Name -> Props.Function -> m (Name, Name)
|
||||
-- | Takes an edge label and a list of names and inserts an import edge to a hole.
|
||||
insertEdge :: Has ScopeGraph sig m => ScopeGraph.EdgeLabel -> NonEmpty Name -> m ()
|
||||
insertEdge label targets = send (InsertEdge label targets pure)
|
||||
|
||||
declareFunction :: forall sig m . (Has ScopeGraph sig m) => Maybe Name -> Props.Function -> m (Name, Name)
|
||||
declareFunction name (Props.Function kind span) = do
|
||||
currentScope' <- currentScope
|
||||
let lexicalEdges = Map.singleton ScopeGraph.Lexical [ currentScope' ]
|
||||
@ -76,7 +84,7 @@ declareFunction name (Props.Function kind span) = do
|
||||
}
|
||||
pure (name', associatedScope)
|
||||
|
||||
declareMaybeName :: Has Sketch sig m
|
||||
declareMaybeName :: Has ScopeGraph sig m
|
||||
=> Maybe Name
|
||||
-> Props.Declaration
|
||||
-> m Name
|
||||
@ -87,9 +95,8 @@ declareMaybeName maybeName props = do
|
||||
name <- Name.gensym
|
||||
name <$ declare name (props { Props.relation = ScopeGraph.Gensym })
|
||||
|
||||
withScope :: Has Sketch sig m
|
||||
withScope :: Has ScopeGraph sig m
|
||||
=> Name
|
||||
-> m a
|
||||
-> m a
|
||||
withScope scope = local (const scope)
|
||||
|
||||
@ -5,7 +5,7 @@
|
||||
-- | The 'Declaration' record type is used by the 'Control.Effect.Sketch' module to keep
|
||||
-- track of the parameters that need to be passed when establishing a new declaration.
|
||||
-- That is to say, it is a record type primarily used for its selector names.
|
||||
module ScopeGraph.Properties.Declaration
|
||||
module Control.Effect.ScopeGraph.Properties.Declaration
|
||||
( Declaration (..)
|
||||
) where
|
||||
|
||||
@ -5,7 +5,7 @@
|
||||
-- | The 'Function' record type is used by the 'Control.Effect.Sketch' module to keep
|
||||
-- track of the parameters that need to be passed when establishing a new declaration.
|
||||
-- That is to say, it is a record type primarily used for its selector names.
|
||||
module ScopeGraph.Properties.Function
|
||||
module Control.Effect.ScopeGraph.Properties.Function
|
||||
( Function (..)
|
||||
) where
|
||||
|
||||
@ -2,7 +2,7 @@
|
||||
-- track of the parameters that need to be passed when establishing a new reference.
|
||||
-- It is currently unused, but will possess more fields in the future as scope graph
|
||||
-- functionality is enhanced.
|
||||
module ScopeGraph.Properties.Reference
|
||||
module Control.Effect.ScopeGraph.Properties.Reference
|
||||
( Reference (..)
|
||||
) where
|
||||
|
||||
@ -1,432 +1,13 @@
|
||||
{-# LANGUAGE DeriveAnyClass #-}
|
||||
{-# LANGUAGE DeriveFunctor #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE TupleSections #-}
|
||||
module Data.ScopeGraph
|
||||
( Slot(..)
|
||||
, Info(..)
|
||||
, associatedScope
|
||||
, lookupDeclaration
|
||||
, declarationByName
|
||||
, declarationsByAccessControl
|
||||
, declarationsByRelation
|
||||
, Declaration(..) -- TODO don't export these constructors
|
||||
, declare
|
||||
, formatDeclaration
|
||||
, EdgeLabel(..)
|
||||
, insertDeclarationScope
|
||||
, insertDeclarationSpan
|
||||
, insertImportReference
|
||||
, newScope
|
||||
, newPreludeScope
|
||||
, insertScope
|
||||
, insertEdge
|
||||
, Path(..)
|
||||
, pathDeclaration
|
||||
, pathOfRef
|
||||
, pathPosition
|
||||
, Position(..)
|
||||
, reference
|
||||
, Reference(..) -- TODO don't export these constructors
|
||||
, ReferenceInfo(..)
|
||||
, Relation(..)
|
||||
, ScopeGraph(..)
|
||||
, Kind(..)
|
||||
, lookupScope
|
||||
, lookupScopePath
|
||||
, Scope(..)
|
||||
, scopeOfRef
|
||||
, pathDeclarationScope
|
||||
, putDeclarationScopeAtPosition
|
||||
, declarationNames
|
||||
, AccessControl(..)
|
||||
( module Scope.Info
|
||||
, module Scope.Path
|
||||
, module Scope.Scope
|
||||
, module Scope.Types
|
||||
, module Scope.Graph.AdjacencyList
|
||||
) where
|
||||
|
||||
import Prelude hiding (lookup)
|
||||
|
||||
import Analysis.Name
|
||||
import Control.Applicative
|
||||
import Control.Lens.Lens
|
||||
import Control.Monad
|
||||
import Data.Aeson
|
||||
import Data.Bifunctor
|
||||
import Data.Foldable
|
||||
import Data.Hashable
|
||||
import Data.Hole
|
||||
import Data.Map.Strict (Map)
|
||||
import qualified Data.Map.Strict as Map
|
||||
import Data.Maybe
|
||||
import Data.Module
|
||||
import Data.Monoid
|
||||
import Data.Semilattice.Lower
|
||||
import Data.Sequence (Seq)
|
||||
import qualified Data.Sequence as Seq
|
||||
import Data.Set (Set)
|
||||
import qualified Data.Set as Set
|
||||
import Data.Text (Text)
|
||||
import GHC.Generics
|
||||
import Source.Span
|
||||
|
||||
-- A slot is a location in the heap where a value is stored.
|
||||
data Slot address = Slot { frameAddress :: address, position :: Position }
|
||||
deriving (Eq, Show, Ord)
|
||||
|
||||
|
||||
data AccessControl = Public
|
||||
| Protected
|
||||
| Private
|
||||
deriving (Bounded, Enum, Eq, Generic, Hashable, ToJSON, Show)
|
||||
|
||||
-- | The Ord AccessControl instance represents an order specification of AccessControls.
|
||||
-- AccessControls that are less than or equal to another AccessControl implies access.
|
||||
-- It is helpful to consider `Public <= Private` as saying "Can a Public syntax term access a Private syntax term?"
|
||||
-- In this way, Public AccessControl is the top of the order specification, and Private AccessControl is the bottom.
|
||||
instance Ord AccessControl where
|
||||
-- | Private AccessControl represents the least overlap or accessibility with other AccessControls.
|
||||
-- When asking if the AccessControl "on the left" is less than the AccessControl "on the right", Private AccessControl on the left always implies access to the thing on the right.
|
||||
(<=) Private _ = True
|
||||
(<=) _ Private = False
|
||||
|
||||
-- | Protected AccessControl is in between Private and Public in the order specification.
|
||||
-- Protected AccessControl "on the left" has access to Protected or Public AccessControls "on the right".
|
||||
(<=) Protected Public = True
|
||||
(<=) Protected Protected = True
|
||||
|
||||
-- | Public AccessControl "on the left" has access only to Public AccessControl "on the right".
|
||||
(<=) Public Public = True
|
||||
(<=) Public _ = False
|
||||
|
||||
|
||||
data Relation = Default | Instance | Prelude | Gensym
|
||||
deriving (Bounded, Enum, Eq, Show, Ord)
|
||||
|
||||
instance Lower Relation where
|
||||
lowerBound = Default
|
||||
|
||||
data Info scopeAddress = Info
|
||||
{ infoDeclaration :: Declaration
|
||||
, infoModule :: ModuleInfo
|
||||
, infoRelation :: Relation
|
||||
, infoAccessControl :: AccessControl
|
||||
, infoSpan :: Span
|
||||
, infoKind :: Kind
|
||||
, infoAssociatedScope :: Maybe scopeAddress
|
||||
} deriving (Eq, Show, Ord)
|
||||
|
||||
instance HasSpan (Info scopeAddress) where
|
||||
span_ = lens infoSpan (\i s -> i { infoSpan = s })
|
||||
{-# INLINE span_ #-}
|
||||
|
||||
instance Lower (Info scopeAddress) where
|
||||
lowerBound = Info lowerBound lowerBound lowerBound Public lowerBound lowerBound Nothing
|
||||
|
||||
data ReferenceInfo = ReferenceInfo
|
||||
{ refSpan :: Span
|
||||
, refKind :: Kind
|
||||
, refModule :: ModuleInfo
|
||||
} deriving (Eq, Show, Ord)
|
||||
|
||||
instance HasSpan ReferenceInfo where
|
||||
span_ = lens refSpan (\r s -> r { refSpan = s })
|
||||
{-# INLINE span_ #-}
|
||||
|
||||
data Kind = AbstractClass
|
||||
| Assignment
|
||||
| Call
|
||||
| Class
|
||||
| DefaultExport
|
||||
| Function
|
||||
| Identifier
|
||||
| Let
|
||||
| MemberAccess
|
||||
| Method
|
||||
| Module
|
||||
| New
|
||||
| Parameter
|
||||
| PublicField
|
||||
| QualifiedAliasedImport
|
||||
| QualifiedExport
|
||||
| QualifiedImport
|
||||
| RequiredParameter
|
||||
| This
|
||||
| TypeAlias
|
||||
| TypeIdentifier
|
||||
| Unknown
|
||||
| UnqualifiedImport
|
||||
| VariableDeclaration
|
||||
deriving (Bounded, Enum, Eq, Show, Ord)
|
||||
|
||||
instance Lower Kind where
|
||||
lowerBound = Unknown
|
||||
|
||||
data Domain
|
||||
= Standard
|
||||
| Preluded
|
||||
deriving (Eq, Show, Ord)
|
||||
|
||||
-- Offsets and frame addresses in the heap should be addresses?
|
||||
data Scope address = Scope
|
||||
{ edges :: Map EdgeLabel [address]
|
||||
, references :: Map Reference ([ReferenceInfo], Path address)
|
||||
, declarations :: Seq (Info address)
|
||||
, domain :: Domain
|
||||
} deriving (Eq, Show, Ord)
|
||||
|
||||
instance Lower (Scope scopeAddress) where
|
||||
lowerBound = Scope mempty mempty mempty Standard
|
||||
|
||||
instance AbstractHole (Scope scopeAddress) where
|
||||
hole = lowerBound
|
||||
|
||||
instance AbstractHole address => AbstractHole (Slot address) where
|
||||
hole = Slot hole (Position 0)
|
||||
|
||||
instance AbstractHole (Info address) where
|
||||
hole = lowerBound
|
||||
|
||||
newtype Position = Position { unPosition :: Int }
|
||||
deriving (Eq, Show, Ord)
|
||||
|
||||
newtype ScopeGraph scope = ScopeGraph { unScopeGraph :: Map scope (Scope scope) }
|
||||
deriving (Eq, Ord, Show)
|
||||
|
||||
instance Ord scope => Lower (ScopeGraph scope) where
|
||||
lowerBound = ScopeGraph mempty
|
||||
|
||||
data Path scope
|
||||
= Hole
|
||||
-- | Construct a direct path to a declaration.
|
||||
| DPath Declaration Position
|
||||
-- | Construct an edge from a scope to another declaration path.
|
||||
| EPath EdgeLabel scope (Path scope)
|
||||
deriving (Eq, Functor, Ord, Show)
|
||||
|
||||
instance AbstractHole (Path scope) where
|
||||
hole = Hole
|
||||
|
||||
-- Returns the declaration of a path.
|
||||
pathDeclaration :: Path scope -> Declaration
|
||||
pathDeclaration (DPath d _) = d
|
||||
pathDeclaration (EPath _ _ p) = pathDeclaration p
|
||||
pathDeclaration Hole = undefined
|
||||
|
||||
-- TODO: Store the current scope closer _in_ the DPath?
|
||||
pathDeclarationScope :: scope -> Path scope -> Maybe scope
|
||||
pathDeclarationScope _ (EPath _ scope (DPath _ _)) = Just scope
|
||||
pathDeclarationScope currentScope (EPath _ _ p) = pathDeclarationScope currentScope p
|
||||
pathDeclarationScope currentScope (DPath _ _) = Just currentScope
|
||||
pathDeclarationScope _ Hole = Nothing
|
||||
|
||||
-- TODO: Possibly return in Maybe since we can have Hole paths
|
||||
pathPosition :: Path scope -> Position
|
||||
pathPosition Hole = Position 0
|
||||
pathPosition (DPath _ p) = p
|
||||
pathPosition (EPath _ _ p) = pathPosition p
|
||||
|
||||
-- Returns the reference paths of a scope in a scope graph.
|
||||
pathsOfScope :: Ord scope => scope -> ScopeGraph scope -> Maybe (Map Reference ([ReferenceInfo], Path scope))
|
||||
pathsOfScope scope = fmap references . Map.lookup scope . unScopeGraph
|
||||
|
||||
-- Returns the declaration data of a scope in a scope graph.
|
||||
ddataOfScope :: Ord scope => scope -> ScopeGraph scope -> Maybe (Seq (Info scope))
|
||||
ddataOfScope scope = fmap declarations . Map.lookup scope . unScopeGraph
|
||||
|
||||
-- Returns the edges of a scope in a scope graph.
|
||||
linksOfScope :: Ord scope => scope -> ScopeGraph scope -> Maybe (Map EdgeLabel [scope])
|
||||
linksOfScope scope = fmap edges . Map.lookup scope . unScopeGraph
|
||||
|
||||
declarationsByAccessControl :: Ord scope => scope -> AccessControl -> ScopeGraph scope -> [ Info scope ]
|
||||
declarationsByAccessControl scope accessControl g = fromMaybe mempty $ do
|
||||
dataSeq <- ddataOfScope scope g
|
||||
pure . toList $ Seq.filter (\Info{..} -> accessControl <= infoAccessControl) dataSeq
|
||||
|
||||
declarationsByRelation :: Ord scope => scope -> Relation -> ScopeGraph scope -> [ Info scope ]
|
||||
declarationsByRelation scope relation g = fromMaybe mempty $ do
|
||||
dataSeq <- ddataOfScope scope g
|
||||
pure . toList $ Seq.filter (\Info{..} -> infoRelation == relation) dataSeq
|
||||
|
||||
declarationByName :: Ord scope => scope -> Declaration -> ScopeGraph scope -> Maybe (Info scope)
|
||||
declarationByName scope name g = do
|
||||
dataSeq <- ddataOfScope scope g
|
||||
find (\Info{..} -> infoDeclaration == name) dataSeq
|
||||
|
||||
-- Lookup a scope in the scope graph.
|
||||
lookupScope :: Ord scope => scope -> ScopeGraph scope -> Maybe (Scope scope)
|
||||
lookupScope scope = Map.lookup scope . unScopeGraph
|
||||
|
||||
-- Declare a declaration with a span and an associated scope in the scope graph.
|
||||
-- TODO: Return the whole value in Maybe or Either.
|
||||
declare :: Ord scope
|
||||
=> Declaration
|
||||
-> ModuleInfo
|
||||
-> Relation
|
||||
-> AccessControl
|
||||
-> Span
|
||||
-> Kind
|
||||
-> Maybe scope
|
||||
-> scope
|
||||
-> ScopeGraph scope
|
||||
-> (ScopeGraph scope, Maybe Position)
|
||||
declare decl moduleInfo rel accessControl declSpan kind assocScope currentScope g = fromMaybe (g, Nothing) $ do
|
||||
scope <- lookupScope currentScope g
|
||||
dataSeq <- ddataOfScope currentScope g
|
||||
case Seq.findIndexR (\Info{..} -> decl == infoDeclaration && declSpan == infoSpan && rel == infoRelation) dataSeq of
|
||||
Just index -> pure (g, Just (Position index))
|
||||
Nothing -> do
|
||||
let newScope = scope { declarations = declarations scope Seq.|> Info decl moduleInfo rel accessControl declSpan kind assocScope }
|
||||
pure (insertScope currentScope newScope g, Just (Position (length (declarations newScope))))
|
||||
|
||||
-- | Add a reference to a declaration in the scope graph.
|
||||
-- Returns the original scope graph if the declaration could not be found.
|
||||
reference :: Ord scope => Reference -> ModuleInfo -> Span -> Kind -> Declaration -> scope -> ScopeGraph scope -> ScopeGraph scope
|
||||
reference ref moduleInfo span kind decl currentAddress g = fromMaybe g $ do
|
||||
-- Start from the current address
|
||||
currentScope' <- lookupScope currentAddress g
|
||||
-- Build a path up to the declaration
|
||||
flip (insertScope currentAddress) g . flip (insertReference ref moduleInfo span kind) currentScope' <$> findPath (const Nothing) decl currentAddress g
|
||||
|
||||
-- | Insert a reference into the given scope by constructing a resolution path to the declaration within the given scope graph.
|
||||
insertImportReference :: Ord address => Reference -> ModuleInfo -> Span -> Kind -> Declaration -> address -> ScopeGraph address -> Scope address -> Maybe (Scope address)
|
||||
insertImportReference ref moduleInfo span kind decl currentAddress g scope = flip (insertReference ref moduleInfo span kind) scope . EPath Import currentAddress <$> findPath (const Nothing) decl currentAddress g
|
||||
|
||||
lookupScopePath :: Ord scopeAddress => Name -> scopeAddress -> ScopeGraph scopeAddress -> Maybe (Path scopeAddress)
|
||||
lookupScopePath declaration currentAddress g = findPath (flip (lookupReference declaration) g) (Declaration declaration) currentAddress g
|
||||
|
||||
findPath :: Ord scopeAddress => (scopeAddress -> Maybe (Path scopeAddress)) -> Declaration -> scopeAddress -> ScopeGraph scopeAddress -> Maybe (Path scopeAddress)
|
||||
findPath extra decl currentAddress g = snd <$> getFirst (foldGraph combine currentAddress g)
|
||||
where combine address path = fmap (address, )
|
||||
$ First (pathToDeclaration decl address g)
|
||||
<> First (extra address)
|
||||
<> (uncurry (EPath Superclass) <$> path Superclass)
|
||||
<> (uncurry (EPath Import) <$> path Import)
|
||||
<> (uncurry (EPath Export) <$> path Export)
|
||||
<> (uncurry (EPath Lexical) <$> path Lexical)
|
||||
|
||||
foldGraph :: (Ord scopeAddress, Monoid a) => (scopeAddress -> (EdgeLabel -> a) -> a) -> scopeAddress -> ScopeGraph scopeAddress -> a
|
||||
foldGraph combine address graph = go lowerBound address
|
||||
where go visited address
|
||||
| address `Set.notMember` visited
|
||||
, Just edges <- linksOfScope address graph = combine address (recur edges)
|
||||
| otherwise = mempty
|
||||
where visited' = Set.insert address visited
|
||||
recur edges edge = maybe mempty (foldMap (go visited')) (Map.lookup edge edges)
|
||||
|
||||
pathToDeclaration :: Ord scopeAddress => Declaration -> scopeAddress -> ScopeGraph scopeAddress -> Maybe (Path scopeAddress)
|
||||
pathToDeclaration decl address g = DPath decl . snd <$> lookupDeclaration (unDeclaration decl) address g
|
||||
|
||||
insertReference :: Reference -> ModuleInfo -> Span -> Kind -> Path scopeAddress -> Scope scopeAddress -> Scope scopeAddress
|
||||
insertReference ref moduleInfo span kind path scope = scope { references = Map.alter (\case
|
||||
Nothing -> pure ([ ReferenceInfo span kind moduleInfo ], path)
|
||||
Just (refInfos, path) -> pure (ReferenceInfo span kind moduleInfo : refInfos, path)) ref (references scope) }
|
||||
|
||||
lookupDeclaration :: Ord scopeAddress => Name -> scopeAddress -> ScopeGraph scopeAddress -> Maybe (Info scopeAddress, Position)
|
||||
lookupDeclaration name scope g = do
|
||||
dataSeq <- ddataOfScope scope g
|
||||
index <- Seq.findIndexR (\Info{..} -> Declaration name == infoDeclaration) dataSeq
|
||||
(, Position index) <$> Seq.lookup index dataSeq
|
||||
|
||||
declarationNames :: Ord address => [EdgeLabel] -> Scope address -> ScopeGraph address -> Set Declaration
|
||||
declarationNames edgeLabels scope scopeGraph = localDeclarations <> edgeNames
|
||||
where addresses = join (Map.elems $ Map.restrictKeys (edges scope) (Set.fromList edgeLabels))
|
||||
edgeNames = flip foldMap addresses $ \address -> maybe mempty (flip (declarationNames edgeLabels) scopeGraph) (lookupScope address scopeGraph)
|
||||
localDeclarations = Set.fromList . toList . fmap infoDeclaration $ declarations scope
|
||||
|
||||
|
||||
putDeclarationScopeAtPosition :: Ord scopeAddress => scopeAddress -> Position -> Maybe scopeAddress -> ScopeGraph scopeAddress -> ScopeGraph scopeAddress
|
||||
putDeclarationScopeAtPosition scope position assocScope g@(ScopeGraph graph) = fromMaybe g $ do
|
||||
dataSeq <- ddataOfScope scope g
|
||||
let seq = Seq.adjust' (\Info{..} -> Info { infoAssociatedScope = assocScope, .. }) (unPosition position) dataSeq
|
||||
pure $ ScopeGraph (Map.adjust (\s -> s { declarations = seq }) scope graph)
|
||||
|
||||
lookupReference :: Ord scopeAddress => Name -> scopeAddress -> ScopeGraph scopeAddress -> Maybe (Path scopeAddress)
|
||||
lookupReference name scope g = fmap snd . Map.lookup (Reference name) =<< pathsOfScope scope g
|
||||
|
||||
insertEdge :: Ord scopeAddress => EdgeLabel -> scopeAddress -> scopeAddress -> ScopeGraph scopeAddress -> ScopeGraph scopeAddress
|
||||
insertEdge label target currentAddress g@(ScopeGraph graph) = fromMaybe g $ do
|
||||
currentScope' <- lookupScope currentAddress g
|
||||
scopes <- maybe (Just mempty) pure (Map.lookup label (edges currentScope'))
|
||||
let newScope = currentScope' { edges = Map.insert label (target : scopes) (edges currentScope') }
|
||||
pure (ScopeGraph (Map.insert currentAddress newScope graph))
|
||||
|
||||
|
||||
-- | Update the 'Scope' containing a 'Declaration' with an associated scope address.
|
||||
-- Returns an unmodified 'ScopeGraph' if the 'Declaration' cannot be found with the given scope address.
|
||||
insertDeclarationScope :: Ord scopeAddress => Declaration -> scopeAddress -> scopeAddress -> ScopeGraph scopeAddress -> ScopeGraph scopeAddress
|
||||
insertDeclarationScope Declaration{..} associatedScopeAddress scopeAddress g = fromMaybe g $ do
|
||||
declScopeAddress <- pathDeclarationScope scopeAddress =<< lookupScopePath unDeclaration scopeAddress g
|
||||
scope <- lookupScope declScopeAddress g
|
||||
(declInfo, position) <- second unPosition <$> lookupDeclaration unDeclaration declScopeAddress g
|
||||
pure $ insertScope declScopeAddress (scope { declarations = Seq.update position (declInfo { infoAssociatedScope = Just associatedScopeAddress }) (declarations scope) }) g
|
||||
|
||||
-- | Insert a declaration span into the declaration in the scope graph.
|
||||
insertDeclarationSpan :: Ord scopeAddress => Declaration -> Span -> ScopeGraph scopeAddress -> ScopeGraph scopeAddress
|
||||
insertDeclarationSpan decl@Declaration{..} span g = fromMaybe g $ do
|
||||
declScopeAddress <- scopeOfDeclaration decl g
|
||||
(declInfo, position) <- second unPosition <$> lookupDeclaration unDeclaration declScopeAddress g
|
||||
scope <- lookupScope declScopeAddress g
|
||||
pure $ insertScope declScopeAddress (scope { declarations = Seq.update position (declInfo { infoSpan = span }) (declarations scope) }) g
|
||||
|
||||
-- | Insert a new scope with the given address and edges into the scope graph.
|
||||
newScope :: Ord address => address -> Map EdgeLabel [address] -> ScopeGraph address -> ScopeGraph address
|
||||
newScope address edges = insertScope address (Scope edges mempty mempty Standard)
|
||||
|
||||
-- | Insert a new scope with the given address and edges into the scope graph.
|
||||
newPreludeScope :: Ord address => address -> Map EdgeLabel [address] -> ScopeGraph address -> ScopeGraph address
|
||||
newPreludeScope address edges = insertScope address (Scope edges mempty mempty Preluded)
|
||||
|
||||
insertScope :: Ord address => address -> Scope address -> ScopeGraph address -> ScopeGraph address
|
||||
insertScope address scope = ScopeGraph . Map.insert address scope . unScopeGraph
|
||||
|
||||
-- | Returns the scope of a reference in the scope graph.
|
||||
scopeOfRef :: Ord scope => Reference -> ScopeGraph scope -> Maybe scope
|
||||
scopeOfRef ref g@(ScopeGraph graph) = go (Map.keys graph)
|
||||
where
|
||||
go (s : scopes') = fromMaybe (go scopes') $ do
|
||||
pathMap <- pathsOfScope s g
|
||||
_ <- Map.lookup ref pathMap
|
||||
pure (Just s)
|
||||
go [] = Nothing
|
||||
|
||||
-- | Returns the path of a reference in the scope graph.
|
||||
pathOfRef :: (Ord scope) => Reference -> ScopeGraph scope -> Maybe (Path scope)
|
||||
pathOfRef ref graph = do
|
||||
scope <- scopeOfRef ref graph
|
||||
pathsMap <- pathsOfScope scope graph
|
||||
snd <$> Map.lookup ref pathsMap
|
||||
|
||||
-- Returns the scope the declaration was declared in.
|
||||
scopeOfDeclaration :: Ord scope => Declaration -> ScopeGraph scope -> Maybe scope
|
||||
scopeOfDeclaration Declaration{..} g@(ScopeGraph graph) = go (Map.keys graph)
|
||||
where
|
||||
go = foldr (\ scope -> (scope <$ lookupDeclaration unDeclaration scope g <|>)) Nothing
|
||||
|
||||
-- | Returns the scope associated with a declaration (the child scope if any exists).
|
||||
associatedScope :: Ord scope => Declaration -> ScopeGraph scope -> Maybe scope
|
||||
associatedScope Declaration{..} g@(ScopeGraph graph) = go (Map.keys graph)
|
||||
where
|
||||
go = foldr lookupAssociatedScope Nothing
|
||||
lookupAssociatedScope scope = ((lookupDeclaration unDeclaration scope g >>= infoAssociatedScope . fst) <|>)
|
||||
|
||||
newtype Reference = Reference { unReference :: Name }
|
||||
deriving (Eq, Ord, Show)
|
||||
|
||||
instance Lower Reference where
|
||||
lowerBound = Reference $ name ""
|
||||
|
||||
newtype Declaration = Declaration { unDeclaration :: Name }
|
||||
deriving (Eq, Ord, Show)
|
||||
|
||||
instance Lower Declaration where
|
||||
lowerBound = Declaration $ name ""
|
||||
|
||||
formatDeclaration :: Declaration -> Text
|
||||
formatDeclaration = formatName . unDeclaration
|
||||
|
||||
-- | The type of edge from a scope to its parent scopes.
|
||||
-- Either a lexical edge or an import edge in the case of non-lexical edges.
|
||||
data EdgeLabel = Lexical | Import | Export | Superclass
|
||||
deriving (Bounded, Enum, Eq, Ord, Show)
|
||||
import Scope.Graph.AdjacencyList
|
||||
import Scope.Info
|
||||
import Scope.Path
|
||||
import Scope.Scope
|
||||
import Scope.Types
|
||||
|
||||
249
semantic-scope-graph/src/Scope/Graph/AdjacencyList.hs
Normal file
249
semantic-scope-graph/src/Scope/Graph/AdjacencyList.hs
Normal file
@ -0,0 +1,249 @@
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE TupleSections #-}
|
||||
module Scope.Graph.AdjacencyList
|
||||
( module Scope.Graph.AdjacencyList
|
||||
) where
|
||||
|
||||
import Analysis.Name
|
||||
import Control.Applicative
|
||||
import Control.Monad
|
||||
import Data.Bifunctor
|
||||
import Data.Foldable
|
||||
import Data.List.NonEmpty (NonEmpty)
|
||||
import qualified Data.List.NonEmpty as NonEmpty
|
||||
import Data.Map.Strict (Map)
|
||||
import qualified Data.Map.Strict as Map
|
||||
import Data.Maybe
|
||||
import Data.Module
|
||||
import Data.Monoid
|
||||
import Data.Semilattice.Lower
|
||||
import Data.Sequence (Seq)
|
||||
import qualified Data.Sequence as Seq
|
||||
import Data.Set (Set)
|
||||
import qualified Data.Set as Set
|
||||
import Scope.Info
|
||||
import Scope.Path
|
||||
import Scope.Reference
|
||||
import Scope.Scope
|
||||
import Scope.Types
|
||||
import Source.Span
|
||||
|
||||
newtype ScopeGraph scope = ScopeGraph { unScopeGraph :: Map scope (Scope scope) }
|
||||
deriving (Eq, Ord, Show)
|
||||
|
||||
instance Ord scope => Lower (ScopeGraph scope) where
|
||||
lowerBound = ScopeGraph mempty
|
||||
|
||||
-- Returns the reference paths of a scope in a scope graph.
|
||||
pathsOfScope :: Ord scope => scope -> ScopeGraph scope -> Maybe (Map Reference ([ReferenceInfo], Path scope))
|
||||
pathsOfScope scope = fmap references . Map.lookup scope . unScopeGraph
|
||||
|
||||
-- Returns the declaration data of a scope in a scope graph.
|
||||
ddataOfScope :: Ord scope => scope -> ScopeGraph scope -> Maybe (Seq (Info scope))
|
||||
ddataOfScope scope = fmap declarations . Map.lookup scope . unScopeGraph
|
||||
|
||||
-- Returns the edges of a scope in a scope graph.
|
||||
linksOfScope :: Ord scope => scope -> ScopeGraph scope -> Maybe (Map EdgeLabel [scope])
|
||||
linksOfScope scope = fmap edges . Map.lookup scope . unScopeGraph
|
||||
|
||||
declarationsByAccessControl :: Ord scope => scope -> AccessControl -> ScopeGraph scope -> [ Info scope ]
|
||||
declarationsByAccessControl scope accessControl g = fromMaybe mempty $ do
|
||||
dataSeq <- ddataOfScope scope g
|
||||
pure . toList $ Seq.filter (\Info{..} -> accessControl <= infoAccessControl) dataSeq
|
||||
|
||||
declarationsByRelation :: Ord scope => scope -> Relation -> ScopeGraph scope -> [ Info scope ]
|
||||
declarationsByRelation scope relation g = fromMaybe mempty $ do
|
||||
dataSeq <- ddataOfScope scope g
|
||||
pure . toList $ Seq.filter (\Info{..} -> infoRelation == relation) dataSeq
|
||||
|
||||
declarationByName :: Ord scope => scope -> Declaration -> ScopeGraph scope -> Maybe (Info scope)
|
||||
declarationByName scope name g = do
|
||||
dataSeq <- ddataOfScope scope g
|
||||
find (\Info{..} -> infoDeclaration == name) dataSeq
|
||||
|
||||
-- Lookup a scope in the scope graph.
|
||||
lookupScope :: Ord scope => scope -> ScopeGraph scope -> Maybe (Scope scope)
|
||||
lookupScope scope = Map.lookup scope . unScopeGraph
|
||||
|
||||
-- Declare a declaration with a span and an associated scope in the scope graph.
|
||||
-- TODO: Return the whole value in Maybe or Either.
|
||||
declare :: Ord scope
|
||||
=> Declaration
|
||||
-> ModuleInfo
|
||||
-> Relation
|
||||
-> AccessControl
|
||||
-> Span
|
||||
-> Kind
|
||||
-> Maybe scope
|
||||
-> scope
|
||||
-> ScopeGraph scope
|
||||
-> (ScopeGraph scope, Maybe Position)
|
||||
declare decl moduleInfo rel accessControl declSpan kind assocScope currentScope g = fromMaybe (g, Nothing) $ do
|
||||
scope <- lookupScope currentScope g
|
||||
dataSeq <- ddataOfScope currentScope g
|
||||
case Seq.findIndexR (\Info{..} -> decl == infoDeclaration && declSpan == infoSpan && rel == infoRelation) dataSeq of
|
||||
Just index -> pure (g, Just (Position index))
|
||||
Nothing -> do
|
||||
let newScope = scope { declarations = declarations scope Seq.|> Info decl moduleInfo rel accessControl declSpan kind assocScope }
|
||||
pure (insertScope currentScope newScope g, Just (Position (length (declarations newScope))))
|
||||
|
||||
-- | Add a reference to a declaration in the scope graph.
|
||||
-- Returns the original scope graph if the declaration could not be found.
|
||||
reference :: Ord scope => Reference -> ModuleInfo -> Span -> Kind -> Declaration -> scope -> ScopeGraph scope -> ScopeGraph scope
|
||||
reference ref moduleInfo span kind decl currentAddress g = fromMaybe g $ do
|
||||
-- Start from the current address
|
||||
currentScope' <- lookupScope currentAddress g
|
||||
-- Build a path up to the declaration
|
||||
flip (insertScope currentAddress) g . flip (insertReference ref moduleInfo span kind) currentScope' <$> findPath (const Nothing) decl currentAddress g
|
||||
|
||||
-- | Insert a reference into the given scope by constructing a resolution path to the declaration within the given scope graph.
|
||||
insertImportReference :: Ord address => Reference -> ModuleInfo -> Span -> Kind -> Declaration -> address -> ScopeGraph address -> Scope address -> Maybe (Scope address)
|
||||
insertImportReference ref moduleInfo span kind decl currentAddress g scope = flip (insertReference ref moduleInfo span kind) scope . EPath Import currentAddress <$> findPath (const Nothing) decl currentAddress g
|
||||
|
||||
lookupScopePath :: Ord scopeAddress => Name -> scopeAddress -> ScopeGraph scopeAddress -> Maybe (Path scopeAddress)
|
||||
lookupScopePath declaration currentAddress g = findPath (flip (lookupReference declaration) g) (Declaration declaration) currentAddress g
|
||||
|
||||
findPath :: Ord scopeAddress => (scopeAddress -> Maybe (Path scopeAddress)) -> Declaration -> scopeAddress -> ScopeGraph scopeAddress -> Maybe (Path scopeAddress)
|
||||
findPath extra decl currentAddress g = snd <$> getFirst (foldGraph combine currentAddress g)
|
||||
where combine address path = fmap (address, )
|
||||
$ First (pathToDeclaration decl address g)
|
||||
<> First (extra address)
|
||||
<> (uncurry (EPath Superclass) <$> path Superclass)
|
||||
<> (uncurry (EPath Import) <$> path Import)
|
||||
<> (uncurry (EPath Export) <$> path Export)
|
||||
<> (uncurry (EPath Lexical) <$> path Lexical)
|
||||
|
||||
foldGraph :: (Ord scopeAddress, Monoid a) => (scopeAddress -> (EdgeLabel -> a) -> a) -> scopeAddress -> ScopeGraph scopeAddress -> a
|
||||
foldGraph combine address graph = go lowerBound address
|
||||
where go visited address
|
||||
| address `Set.notMember` visited
|
||||
, Just edges <- linksOfScope address graph = combine address (recur edges)
|
||||
| otherwise = mempty
|
||||
where visited' = Set.insert address visited
|
||||
recur edges edge = maybe mempty (foldMap (go visited')) (Map.lookup edge edges)
|
||||
|
||||
pathToDeclaration :: Ord scopeAddress => Declaration -> scopeAddress -> ScopeGraph scopeAddress -> Maybe (Path scopeAddress)
|
||||
pathToDeclaration decl address g = DPath decl . snd <$> lookupDeclaration (unDeclaration decl) address g
|
||||
|
||||
insertReference :: Reference -> ModuleInfo -> Span -> Kind -> Path scopeAddress -> Scope scopeAddress -> Scope scopeAddress
|
||||
insertReference ref moduleInfo span kind path scope = scope { references = Map.alter (\case
|
||||
Nothing -> pure ([ ReferenceInfo span kind moduleInfo ], path)
|
||||
Just (refInfos, path) -> pure (ReferenceInfo span kind moduleInfo : refInfos, path)) ref (references scope) }
|
||||
|
||||
lookupDeclaration :: Ord scopeAddress => Name -> scopeAddress -> ScopeGraph scopeAddress -> Maybe (Info scopeAddress, Position)
|
||||
lookupDeclaration name scope g = do
|
||||
dataSeq <- ddataOfScope scope g
|
||||
index <- Seq.findIndexR (\Info{..} -> Declaration name == infoDeclaration) dataSeq
|
||||
(, Position index) <$> Seq.lookup index dataSeq
|
||||
|
||||
declarationNames :: Ord address => [EdgeLabel] -> Scope address -> ScopeGraph address -> Set Declaration
|
||||
declarationNames edgeLabels scope scopeGraph = localDeclarations <> edgeNames
|
||||
where addresses = join (Map.elems $ Map.restrictKeys (edges scope) (Set.fromList edgeLabels))
|
||||
edgeNames = flip foldMap addresses $ \address -> maybe mempty (flip (declarationNames edgeLabels) scopeGraph) (lookupScope address scopeGraph)
|
||||
localDeclarations = Set.fromList . toList . fmap infoDeclaration $ declarations scope
|
||||
|
||||
|
||||
putDeclarationScopeAtPosition :: Ord scopeAddress => scopeAddress -> Position -> Maybe scopeAddress -> ScopeGraph scopeAddress -> ScopeGraph scopeAddress
|
||||
putDeclarationScopeAtPosition scope position assocScope g@(ScopeGraph graph) = fromMaybe g $ do
|
||||
dataSeq <- ddataOfScope scope g
|
||||
let seq = Seq.adjust' (\Info{..} -> Info { infoAssociatedScope = assocScope, .. }) (unPosition position) dataSeq
|
||||
pure $ ScopeGraph (Map.adjust (\s -> s { declarations = seq }) scope graph)
|
||||
|
||||
-- | Lookup a reference by traversing the paths of a given scope and return a Maybe (Path address)
|
||||
lookupReference :: Ord address => Name -> address -> ScopeGraph address -> Maybe (Path address)
|
||||
lookupReference name scope g = fmap snd . Map.lookup (Reference name) =<< pathsOfScope scope g
|
||||
|
||||
insertEdge :: Ord scopeAddress => EdgeLabel -> scopeAddress -> scopeAddress -> ScopeGraph scopeAddress -> ScopeGraph scopeAddress
|
||||
insertEdge label target currentAddress g@(ScopeGraph graph) = fromMaybe g $ do
|
||||
currentScope' <- lookupScope currentAddress g
|
||||
scopes <- maybe (Just mempty) pure (Map.lookup label (edges currentScope'))
|
||||
let newScope = currentScope' { edges = Map.insert label (target : scopes) (edges currentScope') }
|
||||
pure (ScopeGraph (Map.insert currentAddress newScope graph))
|
||||
|
||||
insertEdges :: Ord scopeAddress => NonEmpty EdgeLabel -> scopeAddress -> scopeAddress -> ScopeGraph scopeAddress -> ScopeGraph scopeAddress
|
||||
insertEdges labels target currentAddress g =
|
||||
foldr (\label graph -> insertEdge label target currentAddress graph) g labels
|
||||
|
||||
-- | Add an import edge of the form 'a -> Import -> b -> Import -> c' or creates intermediate void scopes of the form
|
||||
-- 'a -> Void -> b -> Import -> c' if the given scopes cannot be found.
|
||||
addImportEdge :: Ord scopeAddress => EdgeLabel -> [scopeAddress] -> scopeAddress -> ScopeGraph scopeAddress -> ScopeGraph scopeAddress
|
||||
addImportEdge edge importEdge currentAddress g = do
|
||||
case importEdge of
|
||||
[] -> g
|
||||
(name:[]) -> maybe
|
||||
(addImportHole edge name currentAddress g)
|
||||
(const (insertEdge edge name currentAddress g))
|
||||
(lookupScope name g)
|
||||
(name:names) -> let
|
||||
scopeGraph' = maybe
|
||||
(addImportHole edge name currentAddress g)
|
||||
(const (insertEdge edge name currentAddress g))
|
||||
(lookupScope name g)
|
||||
in
|
||||
addImportEdge edge names name scopeGraph'
|
||||
|
||||
addImportHole :: Ord scopeAddress => EdgeLabel -> scopeAddress -> scopeAddress -> ScopeGraph scopeAddress -> ScopeGraph scopeAddress
|
||||
addImportHole edge name currentAddress g = let
|
||||
scopeGraph' = newScope name mempty g
|
||||
in
|
||||
insertEdges (NonEmpty.fromList [Void, edge]) name currentAddress scopeGraph'
|
||||
|
||||
|
||||
-- | Update the 'Scope' containing a 'Declaration' with an associated scope address.
|
||||
-- Returns an unmodified 'ScopeGraph' if the 'Declaration' cannot be found with the given scope address.
|
||||
insertDeclarationScope :: Ord scopeAddress => Declaration -> scopeAddress -> scopeAddress -> ScopeGraph scopeAddress -> ScopeGraph scopeAddress
|
||||
insertDeclarationScope Declaration{..} associatedScopeAddress scopeAddress g = fromMaybe g $ do
|
||||
declScopeAddress <- pathDeclarationScope scopeAddress =<< lookupScopePath unDeclaration scopeAddress g
|
||||
scope <- lookupScope declScopeAddress g
|
||||
(declInfo, position) <- second unPosition <$> lookupDeclaration unDeclaration declScopeAddress g
|
||||
pure $ insertScope declScopeAddress (scope { declarations = Seq.update position (declInfo { infoAssociatedScope = Just associatedScopeAddress }) (declarations scope) }) g
|
||||
|
||||
-- | Insert a declaration span into the declaration in the scope graph.
|
||||
insertDeclarationSpan :: Ord scopeAddress => Declaration -> Span -> ScopeGraph scopeAddress -> ScopeGraph scopeAddress
|
||||
insertDeclarationSpan decl@Declaration{..} span g = fromMaybe g $ do
|
||||
declScopeAddress <- scopeOfDeclaration decl g
|
||||
(declInfo, position) <- second unPosition <$> lookupDeclaration unDeclaration declScopeAddress g
|
||||
scope <- lookupScope declScopeAddress g
|
||||
pure $ insertScope declScopeAddress (scope { declarations = Seq.update position (declInfo { infoSpan = span }) (declarations scope) }) g
|
||||
|
||||
-- | Insert a new scope with the given address and edges into the scope graph.
|
||||
newScope :: Ord address => address -> Map EdgeLabel [address] -> ScopeGraph address -> ScopeGraph address
|
||||
newScope address edges = insertScope address (Scope edges mempty mempty Standard)
|
||||
|
||||
-- | Insert a new scope with the given address and edges into the scope graph.
|
||||
newPreludeScope :: Ord address => address -> Map EdgeLabel [address] -> ScopeGraph address -> ScopeGraph address
|
||||
newPreludeScope address edges = insertScope address (Scope edges mempty mempty Preluded)
|
||||
|
||||
insertScope :: Ord address => address -> Scope address -> ScopeGraph address -> ScopeGraph address
|
||||
insertScope address scope = ScopeGraph . Map.insert address scope . unScopeGraph
|
||||
|
||||
-- | Returns the scope of a reference in the scope graph.
|
||||
scopeOfRef :: Ord scope => Reference -> ScopeGraph scope -> Maybe scope
|
||||
scopeOfRef ref g@(ScopeGraph graph) = go (Map.keys graph)
|
||||
where
|
||||
go (s : scopes') = fromMaybe (go scopes') $ do
|
||||
pathMap <- pathsOfScope s g
|
||||
_ <- Map.lookup ref pathMap
|
||||
pure (Just s)
|
||||
go [] = Nothing
|
||||
|
||||
-- | Returns the path of a reference in the scope graph.
|
||||
pathOfRef :: (Ord scope) => Reference -> ScopeGraph scope -> Maybe (Path scope)
|
||||
pathOfRef ref graph = do
|
||||
scope <- scopeOfRef ref graph
|
||||
pathsMap <- pathsOfScope scope graph
|
||||
snd <$> Map.lookup ref pathsMap
|
||||
|
||||
-- Returns the scope the declaration was declared in.
|
||||
scopeOfDeclaration :: Ord scope => Declaration -> ScopeGraph scope -> Maybe scope
|
||||
scopeOfDeclaration Declaration{..} g@(ScopeGraph graph) = go (Map.keys graph)
|
||||
where
|
||||
go = foldr (\ scope -> (scope <$ lookupDeclaration unDeclaration scope g <|>)) Nothing
|
||||
|
||||
-- | Returns the scope associated with a declaration (the child scope if any exists).
|
||||
associatedScope :: Ord scope => Declaration -> ScopeGraph scope -> Maybe scope
|
||||
associatedScope Declaration{..} g@(ScopeGraph graph) = go (Map.keys graph)
|
||||
where
|
||||
go = foldr lookupAssociatedScope Nothing
|
||||
lookupAssociatedScope scope = ((lookupDeclaration unDeclaration scope g >>= infoAssociatedScope . fst) <|>)
|
||||
@ -6,21 +6,21 @@
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
module ScopeGraph.Convert
|
||||
module Scope.Graph.Convert
|
||||
( ToScopeGraph (..)
|
||||
, Result (..)
|
||||
, todo
|
||||
, complete
|
||||
) where
|
||||
|
||||
import Control.Effect.Sketch
|
||||
import Control.Effect.ScopeGraph
|
||||
import Data.List.NonEmpty
|
||||
import Data.Typeable
|
||||
import Source.Loc
|
||||
|
||||
class Typeable t => ToScopeGraph t where
|
||||
scopeGraph ::
|
||||
( Has Sketch sig m
|
||||
( Has ScopeGraph sig m
|
||||
)
|
||||
=> t Loc
|
||||
-> m Result
|
||||
61
semantic-scope-graph/src/Scope/Info.hs
Normal file
61
semantic-scope-graph/src/Scope/Info.hs
Normal file
@ -0,0 +1,61 @@
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE DeriveAnyClass #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
module Scope.Info
|
||||
( Info (..)
|
||||
, Declaration (..)
|
||||
, formatDeclaration
|
||||
, Relation (..)
|
||||
, Kind (..)
|
||||
, AccessControl (..)
|
||||
) where
|
||||
|
||||
import Analysis.Name
|
||||
import Data.Generics.Product (field)
|
||||
import Data.Hole
|
||||
import Data.Module
|
||||
import Data.Semilattice.Lower
|
||||
import Data.Text (Text)
|
||||
import GHC.Generics (Generic)
|
||||
import Scope.Types
|
||||
import Source.Span
|
||||
|
||||
data Info scopeAddress = Info
|
||||
{ infoDeclaration :: Declaration
|
||||
, infoModule :: ModuleInfo
|
||||
, infoRelation :: Relation
|
||||
, infoAccessControl :: AccessControl
|
||||
, infoSpan :: Span
|
||||
, infoKind :: Kind
|
||||
, infoAssociatedScope :: Maybe scopeAddress
|
||||
} deriving (Eq, Show, Ord, Generic)
|
||||
|
||||
instance HasSpan (Info scopeAddress) where
|
||||
span_ = field @"infoSpan"
|
||||
{-# INLINE span_ #-}
|
||||
|
||||
instance Lower (Info scopeAddress) where
|
||||
lowerBound = Info lowerBound lowerBound lowerBound Public lowerBound lowerBound Nothing
|
||||
|
||||
instance AbstractHole (Info address) where
|
||||
hole = lowerBound
|
||||
|
||||
newtype Declaration = Declaration { unDeclaration :: Name }
|
||||
deriving (Eq, Ord, Show)
|
||||
|
||||
instance Lower Declaration where
|
||||
lowerBound = Declaration $ name ""
|
||||
|
||||
formatDeclaration :: Declaration -> Text
|
||||
formatDeclaration = formatName . unDeclaration
|
||||
|
||||
|
||||
data Relation = Default | Instance | Prelude | Gensym
|
||||
deriving (Bounded, Enum, Eq, Show, Ord)
|
||||
|
||||
instance Lower Relation where
|
||||
lowerBound = Default
|
||||
|
||||
|
||||
41
semantic-scope-graph/src/Scope/Path.hs
Normal file
41
semantic-scope-graph/src/Scope/Path.hs
Normal file
@ -0,0 +1,41 @@
|
||||
{-# LANGUAGE DeriveFunctor #-}
|
||||
module Scope.Path
|
||||
( Path (..)
|
||||
, pathDeclaration
|
||||
, pathDeclarationScope
|
||||
, pathPosition
|
||||
) where
|
||||
|
||||
import Data.Hole
|
||||
import Scope.Info
|
||||
import Scope.Types
|
||||
|
||||
data Path scope
|
||||
= Hole
|
||||
-- | Construct a direct path to a declaration.
|
||||
| DPath Declaration Position
|
||||
-- | Construct an edge from a scope to another declaration path.
|
||||
| EPath EdgeLabel scope (Path scope)
|
||||
deriving (Eq, Functor, Ord, Show)
|
||||
|
||||
instance AbstractHole (Path scope) where
|
||||
hole = Hole
|
||||
|
||||
-- Returns the declaration of a path.
|
||||
pathDeclaration :: Path scope -> Declaration
|
||||
pathDeclaration (DPath d _) = d
|
||||
pathDeclaration (EPath _ _ p) = pathDeclaration p
|
||||
pathDeclaration Hole = undefined
|
||||
|
||||
-- TODO: Store the current scope closer _in_ the DPath?
|
||||
pathDeclarationScope :: scope -> Path scope -> Maybe scope
|
||||
pathDeclarationScope _ (EPath _ scope (DPath _ _)) = Just scope
|
||||
pathDeclarationScope currentScope (EPath _ _ p) = pathDeclarationScope currentScope p
|
||||
pathDeclarationScope currentScope (DPath _ _) = Just currentScope
|
||||
pathDeclarationScope _ Hole = Nothing
|
||||
|
||||
-- TODO: Possibly return in Maybe since we can have Hole paths
|
||||
pathPosition :: Path scope -> Position
|
||||
pathPosition Hole = Position 0
|
||||
pathPosition (DPath _ p) = p
|
||||
pathPosition (EPath _ _ p) = pathPosition p
|
||||
28
semantic-scope-graph/src/Scope/Reference.hs
Normal file
28
semantic-scope-graph/src/Scope/Reference.hs
Normal file
@ -0,0 +1,28 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
module Scope.Reference
|
||||
( ReferenceInfo (..)
|
||||
, Reference (..)
|
||||
) where
|
||||
|
||||
import Analysis.Name
|
||||
import Control.Lens (lens)
|
||||
import Data.Module
|
||||
import Data.Semilattice.Lower
|
||||
import Scope.Types
|
||||
import Source.Span
|
||||
|
||||
data ReferenceInfo = ReferenceInfo
|
||||
{ refSpan :: Span
|
||||
, refKind :: Kind
|
||||
, refModule :: ModuleInfo
|
||||
} deriving (Eq, Show, Ord)
|
||||
|
||||
instance HasSpan ReferenceInfo where
|
||||
span_ = lens refSpan (\r s -> r { refSpan = s })
|
||||
{-# INLINE span_ #-}
|
||||
|
||||
newtype Reference = Reference { unReference :: Name }
|
||||
deriving (Eq, Ord, Show)
|
||||
|
||||
instance Lower Reference where
|
||||
lowerBound = Reference $ name ""
|
||||
30
semantic-scope-graph/src/Scope/Scope.hs
Normal file
30
semantic-scope-graph/src/Scope/Scope.hs
Normal file
@ -0,0 +1,30 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
module Scope.Scope
|
||||
( Scope (..)
|
||||
, Reference (..)
|
||||
, ReferenceInfo (..)
|
||||
, Domain (..)
|
||||
) where
|
||||
|
||||
import Data.Hole
|
||||
import Data.Map.Strict (Map)
|
||||
import Data.Semilattice.Lower
|
||||
import Data.Sequence (Seq)
|
||||
import Scope.Info
|
||||
import Scope.Path
|
||||
import Scope.Reference
|
||||
import Scope.Types
|
||||
|
||||
-- Offsets and frame addresses in the heap should be addresses?
|
||||
data Scope address = Scope
|
||||
{ edges :: Map EdgeLabel [address]
|
||||
, references :: Map Reference ([ReferenceInfo], Path address)
|
||||
, declarations :: Seq (Info address)
|
||||
, domain :: Domain
|
||||
} deriving (Eq, Show, Ord)
|
||||
|
||||
instance Lower (Scope scopeAddress) where
|
||||
lowerBound = Scope mempty mempty mempty Standard
|
||||
|
||||
instance AbstractHole (Scope scopeAddress) where
|
||||
hole = lowerBound
|
||||
94
semantic-scope-graph/src/Scope/Types.hs
Normal file
94
semantic-scope-graph/src/Scope/Types.hs
Normal file
@ -0,0 +1,94 @@
|
||||
{-# LANGUAGE DeriveAnyClass #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
module Scope.Types
|
||||
( Slot (..)
|
||||
, EdgeLabel (..)
|
||||
, Position (..)
|
||||
, Domain (..)
|
||||
, Kind (..)
|
||||
, AccessControl (..)
|
||||
) where
|
||||
|
||||
import Data.Aeson (ToJSON)
|
||||
import Data.Hashable
|
||||
import Data.Hole
|
||||
import Data.Semilattice.Lower
|
||||
import GHC.Generics (Generic)
|
||||
|
||||
-- A slot is a location in the heap where a value is stored.
|
||||
data Slot address = Slot { frameAddress :: address, position :: Position }
|
||||
deriving (Eq, Show, Ord)
|
||||
|
||||
instance AbstractHole address => AbstractHole (Slot address) where
|
||||
hole = Slot hole (Position 0)
|
||||
|
||||
|
||||
-- | The type of edge from a scope to its parent scopes.
|
||||
-- Either a lexical edge or an import edge in the case of non-lexical edges.
|
||||
data EdgeLabel = Lexical | Import | Export | Superclass | Void
|
||||
deriving (Bounded, Enum, Eq, Ord, Show)
|
||||
|
||||
|
||||
newtype Position = Position { unPosition :: Int }
|
||||
deriving (Eq, Show, Ord)
|
||||
|
||||
|
||||
data Domain
|
||||
= Standard
|
||||
| Preluded
|
||||
deriving (Eq, Show, Ord)
|
||||
|
||||
|
||||
data Kind = AbstractClass
|
||||
| Assignment
|
||||
| Call
|
||||
| Class
|
||||
| DefaultExport
|
||||
| Function
|
||||
| Identifier
|
||||
| Let
|
||||
| MemberAccess
|
||||
| Method
|
||||
| Module
|
||||
| New
|
||||
| Parameter
|
||||
| PublicField
|
||||
| QualifiedAliasedImport
|
||||
| QualifiedExport
|
||||
| QualifiedImport
|
||||
| RequiredParameter
|
||||
| This
|
||||
| TypeAlias
|
||||
| TypeIdentifier
|
||||
| Unknown
|
||||
| UnqualifiedImport
|
||||
| VariableDeclaration
|
||||
deriving (Bounded, Enum, Eq, Show, Ord)
|
||||
|
||||
instance Lower Kind where
|
||||
lowerBound = Unknown
|
||||
|
||||
|
||||
data AccessControl = Public
|
||||
| Protected
|
||||
| Private
|
||||
deriving (Bounded, Enum, Eq, Generic, Hashable, ToJSON, Show)
|
||||
|
||||
-- | The Ord AccessControl instance represents an order specification of AccessControls.
|
||||
-- AccessControls that are less than or equal to another AccessControl implies access.
|
||||
-- It is helpful to consider `Public <= Private` as saying "Can a Public syntax term access a Private syntax term?"
|
||||
-- In this way, Public AccessControl is the top of the order specification, and Private AccessControl is the bottom.
|
||||
instance Ord AccessControl where
|
||||
-- | Private AccessControl represents the least overlap or accessibility with other AccessControls.
|
||||
-- When asking if the AccessControl "on the left" is less than the AccessControl "on the right", Private AccessControl on the left always implies access to the thing on the right.
|
||||
(<=) Private _ = True
|
||||
(<=) _ Private = False
|
||||
|
||||
-- | Protected AccessControl is in between Private and Public in the order specification.
|
||||
-- Protected AccessControl "on the left" has access to Protected or Public AccessControls "on the right".
|
||||
(<=) Protected Public = True
|
||||
(<=) Protected Protected = True
|
||||
|
||||
-- | Public AccessControl "on the left" has access only to Public AccessControl "on the right".
|
||||
(<=) Public Public = True
|
||||
(<=) Public _ = False
|
||||
@ -34,7 +34,7 @@ import Data.List.NonEmpty (NonEmpty, nonEmpty)
|
||||
import qualified Data.Map as Map
|
||||
|
||||
import Control.Abstract hiding
|
||||
(Array (..), Boolean (..), Function (..), Hash (..), Numeric (..), Object (..), String (..), Unit (..), While (..))
|
||||
(Array (..), Boolean (..), Function (..), Hash (..), Numeric (..), Object (..), String (..), Unit (..), While (..), Void)
|
||||
import qualified Control.Abstract as Abstract
|
||||
import Data.Abstract.BaseError
|
||||
import Data.Abstract.Evaluatable
|
||||
|
||||
@ -14,7 +14,7 @@ module Data.Syntax.Expression (module Data.Syntax.Expression) where
|
||||
import Prelude hiding (null)
|
||||
|
||||
import Analysis.Name as Name
|
||||
import Control.Abstract hiding (Bitwise (..), Call)
|
||||
import Control.Abstract hiding (Bitwise (..), Call, Void)
|
||||
import Control.Applicative
|
||||
import Control.Monad
|
||||
import Data.Abstract.Evaluatable as Abstract
|
||||
|
||||
Loading…
Reference in New Issue
Block a user