From 4530d0c1d4bbe7ae9c2abea9d024ab27422a9011 Mon Sep 17 00:00:00 2001 From: joshvera Date: Wed, 29 Jan 2020 14:14:08 -0500 Subject: [PATCH 01/29] Stub import hole test --- semantic-python/test-graphing/GraphTest.hs | 14 ++++++++++++++ .../test/fixtures/cheese/6-01-imports.py | 1 + semantic-python/test/fixtures/cheese/ints.py | 5 +++++ 3 files changed, 20 insertions(+) create mode 100644 semantic-python/test/fixtures/cheese/6-01-imports.py create mode 100644 semantic-python/test/fixtures/cheese/ints.py diff --git a/semantic-python/test-graphing/GraphTest.hs b/semantic-python/test-graphing/GraphTest.hs index ce30b84a7..ebfb5cc67 100644 --- a/semantic-python/test-graphing/GraphTest.hs +++ b/semantic-python/test-graphing/GraphTest.hs @@ -102,6 +102,9 @@ expectedFunctionArg = do reference "foo" "foo" RefProperties pure Complete +expectedImportHole :: (Has Sketch sig m) => m Result +expectedImportHole = undefined + assertLexicalScope :: HUnit.Assertion assertLexicalScope = do let path = "semantic-python/test/fixtures/5-02-simple-function.py" @@ -118,6 +121,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-import-holes.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 @@ -136,5 +147,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 ] ] diff --git a/semantic-python/test/fixtures/cheese/6-01-imports.py b/semantic-python/test/fixtures/cheese/6-01-imports.py new file mode 100644 index 000000000..5ce8582d6 --- /dev/null +++ b/semantic-python/test/fixtures/cheese/6-01-imports.py @@ -0,0 +1 @@ +from cheese.ints import * diff --git a/semantic-python/test/fixtures/cheese/ints.py b/semantic-python/test/fixtures/cheese/ints.py new file mode 100644 index 000000000..cd81106f3 --- /dev/null +++ b/semantic-python/test/fixtures/cheese/ints.py @@ -0,0 +1,5 @@ +def one(): + return 1 + +def two(): + return 2 From be4ba8063dab4a9cdf5e9b74403e5ba9a741812e Mon Sep 17 00:00:00 2001 From: joshvera Date: Wed, 29 Jan 2020 14:43:17 -0500 Subject: [PATCH 02/29] stub in ImportFromStatement --- semantic-python/src/Language/Python/ScopeGraph.hs | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/semantic-python/src/Language/Python/ScopeGraph.hs b/semantic-python/src/Language/Python/ScopeGraph.hs index 14776d987..ef5153d9f 100644 --- a/semantic-python/src/Language/Python/ScopeGraph.hs +++ b/semantic-python/src/Language/Python/ScopeGraph.hs @@ -218,7 +218,11 @@ 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 + complete <* insertEdge ScopeGraph.Import names + + instance ToScopeGraph Py.Lambda where scopeGraph = todo From e6460394e8a5f53476b0470fd481d7505978315d Mon Sep 17 00:00:00 2001 From: joshvera Date: Thu, 30 Jan 2020 17:06:34 -0500 Subject: [PATCH 03/29] Create Import edge paths in Import statements --- .../src/Language/Python/ScopeGraph.hs | 3 +- .../test/fixtures/cheese/6-01-imports.py | 22 +++++++++++++++ .../src/Control/Carrier/Sketch/Fresh.hs | 6 ++++ .../src/Control/Effect/Sketch.hs | 28 ++++++------------- semantic-scope-graph/src/Data/ScopeGraph.hs | 7 +++-- src/Control/Abstract/ScopeGraph.hs | 2 +- 6 files changed, 43 insertions(+), 25 deletions(-) diff --git a/semantic-python/src/Language/Python/ScopeGraph.hs b/semantic-python/src/Language/Python/ScopeGraph.hs index ef5153d9f..ab99cb2fe 100644 --- a/semantic-python/src/Language/Python/ScopeGraph.hs +++ b/semantic-python/src/Language/Python/ScopeGraph.hs @@ -220,7 +220,8 @@ instance ToScopeGraph Py.ImportStatement where scopeGraph = todo instance ToScopeGraph Py.ImportFromStatement where scopeGraph (Py.ImportFromStatement _ [] (L1 (Py.DottedName _ names)) (Just (Py.WildcardImport _ _))) = do - complete <* insertEdge ScopeGraph.Import names + let toName (Py.Identifier _ name) = Name.name name + complete <* insertEdge ScopeGraph.Import (toName <$> names) diff --git a/semantic-python/test/fixtures/cheese/6-01-imports.py b/semantic-python/test/fixtures/cheese/6-01-imports.py index 5ce8582d6..c97dee19a 100644 --- a/semantic-python/test/fixtures/cheese/6-01-imports.py +++ b/semantic-python/test/fixtures/cheese/6-01-imports.py @@ -1 +1,23 @@ from cheese.ints import * + +# EPath Import currentScope (Hole (cheese, ints)) + + +# data Scope address = Scope +# { edges :: Map EdgeLabel [address] +# , references :: Map Reference ([ReferenceInfo], Path address) +# , partialPaths :: Path address +# , declarations :: Seq (Info address) +# , domain :: Domain + + +# data Path scope +# = Hole (NonEmpty Name) +# -- | 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) + +# Scope +# references = Map (Reference one) diff --git a/semantic-scope-graph/src/Control/Carrier/Sketch/Fresh.hs b/semantic-scope-graph/src/Control/Carrier/Sketch/Fresh.hs index c4c15c773..1aab50969 100644 --- a/semantic-scope-graph/src/Control/Carrier/Sketch/Fresh.hs +++ b/semantic-scope-graph/src/Control/Carrier/Sketch/Fresh.hs @@ -91,6 +91,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.insertEdge label 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 diff --git a/semantic-scope-graph/src/Control/Effect/Sketch.hs b/semantic-scope-graph/src/Control/Effect/Sketch.hs index f2fb98641..2a4e0d2b8 100644 --- a/semantic-scope-graph/src/Control/Effect/Sketch.hs +++ b/semantic-scope-graph/src/Control/Effect/Sketch.hs @@ -20,6 +20,7 @@ module Control.Effect.Sketch , declare -- Scope Manipulation , currentScope + , insertEdge , newScope , withScope , declareFunction @@ -28,17 +29,18 @@ module Control.Effect.Sketch , Has ) where +import Analysis.Name (Name) +import qualified Analysis.Name as Name import Control.Algebra import Control.Effect.Fresh import Control.Effect.Reader import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map -import Analysis.Name (Name) -import qualified Analysis.Name as Name import qualified Data.ScopeGraph as ScopeGraph import Data.Text (Text) import GHC.Generics (Generic, Generic1) import GHC.Records +import Data.List.NonEmpty data DeclProperties = DeclProperties { kind :: ScopeGraph.Kind @@ -60,6 +62,7 @@ data SketchEff m k = Declare Name DeclProperties (() -> m k) | Reference Text Text RefProperties (() -> 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 @@ -75,6 +78,9 @@ 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 edges = send (NewScope edges pure) +insertEdge :: Has Sketch sig m => ScopeGraph.EdgeLabel -> NonEmpty Name -> m () +insertEdge label targets = send (InsertEdge label targets pure) + declareFunction :: forall sig m . (Has Sketch sig m) => Maybe Name -> FunProperties -> m (Name, Name) declareFunction name props = do currentScope' <- currentScope @@ -97,21 +103,3 @@ withScope :: Has Sketch sig m -> m a -> m a withScope scope = local (const scope) --- declareFunction :: ( Has (State (ScopeGraph address)) sig m --- , Has (Allocator address) sig m --- , Has (Reader (CurrentScope address)) sig m --- , Has (Reader ModuleInfo) sig m --- , Has Fresh sig m --- , Ord address --- ) --- => Maybe Name --- -> ScopeGraph.AccessControl --- -> Span --- -> ScopeGraph.Kind --- -> Evaluator term address value m (Name, address) --- declareFunction name accessControl span kind = do --- currentScope' <- currentScope --- let lexicalEdges = Map.singleton Lexical [ currentScope' ] --- associatedScope <- newScope lexicalEdges --- name' <- declareMaybeName name Default accessControl span kind (Just associatedScope) --- pure (name', associatedScope) diff --git a/semantic-scope-graph/src/Data/ScopeGraph.hs b/semantic-scope-graph/src/Data/ScopeGraph.hs index c4241702d..fee0b2bf5 100644 --- a/semantic-scope-graph/src/Data/ScopeGraph.hs +++ b/semantic-scope-graph/src/Data/ScopeGraph.hs @@ -70,6 +70,7 @@ import qualified Data.Set as Set import Data.Text (Text) import GHC.Generics import Source.Span +import Data.List.NonEmpty (NonEmpty) -- A slot is a location in the heap where a value is stored. data Slot address = Slot { frameAddress :: address, position :: Position } @@ -345,11 +346,11 @@ putDeclarationScopeAtPosition scope position assocScope g@(ScopeGraph graph) = f 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 +insertEdge :: Ord scopeAddress => EdgeLabel -> NonEmpty scopeAddress -> scopeAddress -> ScopeGraph scopeAddress -> ScopeGraph scopeAddress +insertEdge label targets 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') } + let newScope = currentScope' { edges = Map.insert label (toList targets <> scopes) (edges currentScope') } pure (ScopeGraph (Map.insert currentAddress newScope graph)) diff --git a/src/Control/Abstract/ScopeGraph.hs b/src/Control/Abstract/ScopeGraph.hs index f9a8158cd..6819272c4 100644 --- a/src/Control/Abstract/ScopeGraph.hs +++ b/src/Control/Abstract/ScopeGraph.hs @@ -162,7 +162,7 @@ insertEdge :: ( Has (State (ScopeGraph address)) sig m -> Evaluator term address value m () insertEdge label target = do currentAddress <- currentScope - modify (ScopeGraph.insertEdge label target currentAddress) + modify (ScopeGraph.insertEdge label (pure target) currentAddress) -- | Inserts a new scope into the scope graph with the given edges. newScope :: ( Has (Allocator address) sig m From 65e661552bc51a02270de30571463576443917ae Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Tue, 4 Feb 2020 18:31:03 -0500 Subject: [PATCH 04/29] Silence REPL macro-redefined warnings from the C compiler. In certain cases, use of the REPL can land us in a state where there are multiple `cabal_macros.h` files being included, leading to duplicate macro definitions. This does not factor into correctness, as these duplicates are, well, duplicate definitions, but the warning is tedious, so this patch passes `-Wno-macro-redefined` to the C compiler. --- script/ghci-flags | 2 ++ 1 file changed, 2 insertions(+) diff --git a/script/ghci-flags b/script/ghci-flags index 627c9f3e8..457ba6177 100755 --- a/script/ghci-flags +++ b/script/ghci-flags @@ -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" From b95a575ae22241077a5ed3607604b2e288f2bae3 Mon Sep 17 00:00:00 2001 From: joshvera Date: Wed, 5 Feb 2020 18:03:53 -0500 Subject: [PATCH 05/29] Change insertEdge to take 1 edge --- semantic-python/test-graphing/GraphTest.hs | 7 +++++-- semantic-scope-graph/src/Data/ScopeGraph.hs | 4 ++-- 2 files changed, 7 insertions(+), 4 deletions(-) diff --git a/semantic-python/test-graphing/GraphTest.hs b/semantic-python/test-graphing/GraphTest.hs index ebfb5cc67..e915438fc 100644 --- a/semantic-python/test-graphing/GraphTest.hs +++ b/semantic-python/test-graphing/GraphTest.hs @@ -103,7 +103,10 @@ expectedFunctionArg = do pure Complete expectedImportHole :: (Has Sketch sig m) => m Result -expectedImportHole = undefined +expectedImportHole = do + addImportEdge Import ["cheese", "ints"] + + assertLexicalScope :: HUnit.Assertion assertLexicalScope = do @@ -123,7 +126,7 @@ assertFunctionArg = do assertImportHole :: HUnit.Assertion assertImportHole = do - let path = "semantic-python/test/fixtures/cheese/6-01-import-holes.py" + 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 diff --git a/semantic-scope-graph/src/Data/ScopeGraph.hs b/semantic-scope-graph/src/Data/ScopeGraph.hs index fee0b2bf5..f8992c24c 100644 --- a/semantic-scope-graph/src/Data/ScopeGraph.hs +++ b/semantic-scope-graph/src/Data/ScopeGraph.hs @@ -346,8 +346,8 @@ putDeclarationScopeAtPosition scope position assocScope g@(ScopeGraph graph) = f 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 -> NonEmpty scopeAddress -> scopeAddress -> ScopeGraph scopeAddress -> ScopeGraph scopeAddress -insertEdge label targets currentAddress g@(ScopeGraph graph) = fromMaybe g $ do +insertEdge :: Ord scopeAddress => EdgeLabel -> scopeAddress -> scopeAddress -> ScopeGraph scopeAddress -> ScopeGraph scopeAddress +insertEdge label hole 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 (toList targets <> scopes) (edges currentScope') } From 24135907909a82656969b72f3990a71ac01d86f3 Mon Sep 17 00:00:00 2001 From: joshvera Date: Wed, 5 Feb 2020 18:35:44 -0500 Subject: [PATCH 06/29] add addImportEdge and addImportHole --- semantic-python/src/Language/Python.hs | 2 -- .../src/Control/Carrier/Sketch/Fresh.hs | 2 +- semantic-scope-graph/src/Data/ScopeGraph.hs | 23 ++++++++++++++++--- 3 files changed, 21 insertions(+), 6 deletions(-) diff --git a/semantic-python/src/Language/Python.hs b/semantic-python/src/Language/Python.hs index 8aa115835..0539ba4e6 100644 --- a/semantic-python/src/Language/Python.hs +++ b/semantic-python/src/Language/Python.hs @@ -12,8 +12,6 @@ import qualified Tags.Tagging.Precise as Tags import qualified TreeSitter.Python (tree_sitter_python) import qualified TreeSitter.Python.AST as Py import qualified TreeSitter.Unmarshal as TS -import qualified Data.ScopeGraph as ScopeGraph -import qualified Control.Effect.Sketch as Sketch newtype Term a = Term { getTerm :: Py.Module a } diff --git a/semantic-scope-graph/src/Control/Carrier/Sketch/Fresh.hs b/semantic-scope-graph/src/Control/Carrier/Sketch/Fresh.hs index 1aab50969..8aad15695 100644 --- a/semantic-scope-graph/src/Control/Carrier/Sketch/Fresh.hs +++ b/semantic-scope-graph/src/Control/Carrier/Sketch/Fresh.hs @@ -93,7 +93,7 @@ instance (Effect sig, Algebra sig m) => Algebra (SketchEff :+: Reader Name :+: F k name alg (L (InsertEdge label address k)) = do Sketchbook old current <- SketchC get - let new = ScopeGraph.insertEdge label address current old + let new = ScopeGraph.addImportEdge label address current old SketchC (put (Sketchbook new current)) k () diff --git a/semantic-scope-graph/src/Data/ScopeGraph.hs b/semantic-scope-graph/src/Data/ScopeGraph.hs index f8992c24c..520573b22 100644 --- a/semantic-scope-graph/src/Data/ScopeGraph.hs +++ b/semantic-scope-graph/src/Data/ScopeGraph.hs @@ -23,6 +23,8 @@ module Data.ScopeGraph , insertImportReference , newScope , newPreludeScope + , addImportHole + , addImportEdge , insertScope , insertEdge , Path(..) @@ -70,7 +72,8 @@ import qualified Data.Set as Set import Data.Text (Text) import GHC.Generics import Source.Span -import Data.List.NonEmpty (NonEmpty) +import Data.List.NonEmpty (NonEmpty(..)) +import qualified Data.List.NonEmpty as NonEmpty -- A slot is a location in the heap where a value is stored. data Slot address = Slot { frameAddress :: address, position :: Position } @@ -347,12 +350,26 @@ lookupReference :: Ord scopeAddress => Name -> scopeAddress -> ScopeGraph scopeA 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 hole currentAddress g@(ScopeGraph graph) = fromMaybe g $ do +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 (toList targets <> scopes) (edges currentScope') } + let newScope = currentScope' { edges = Map.insert label (target : scopes) (edges currentScope') } pure (ScopeGraph (Map.insert currentAddress newScope graph)) +addImportEdge :: Ord scopeAddress => EdgeLabel -> NonEmpty scopeAddress -> scopeAddress -> ScopeGraph scopeAddress -> ScopeGraph scopeAddress +addImportEdge edge names currentAddress g = do + case names of + (x :| []) -> addImportHole Import x currentAddress g + (x :| xs) -> do + let scopeGraph' = newScope x mempty g + addImportEdge edge (NonEmpty.fromList xs) x scopeGraph' + + +addImportHole :: Ord scopeAddress => EdgeLabel -> scopeAddress -> scopeAddress -> ScopeGraph scopeAddress -> ScopeGraph scopeAddress +addImportHole label name currentAddress g = fromMaybe g $ do + let scope' = newScope name mempty g + pure (insertEdge label name currentAddress scope') + -- | 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. From 8e65043578d6237072611f60b8aeecddd0212636 Mon Sep 17 00:00:00 2001 From: joshvera Date: Wed, 5 Feb 2020 19:46:08 -0500 Subject: [PATCH 07/29] insertEdge now takes a target scope's name --- src/Control/Abstract/ScopeGraph.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Control/Abstract/ScopeGraph.hs b/src/Control/Abstract/ScopeGraph.hs index 6819272c4..f9a8158cd 100644 --- a/src/Control/Abstract/ScopeGraph.hs +++ b/src/Control/Abstract/ScopeGraph.hs @@ -162,7 +162,7 @@ insertEdge :: ( Has (State (ScopeGraph address)) sig m -> Evaluator term address value m () insertEdge label target = do currentAddress <- currentScope - modify (ScopeGraph.insertEdge label (pure target) currentAddress) + modify (ScopeGraph.insertEdge label target currentAddress) -- | Inserts a new scope into the scope graph with the given edges. newScope :: ( Has (Allocator address) sig m From f927f0b8c0f12bc077af50b448235076d4d027b6 Mon Sep 17 00:00:00 2001 From: joshvera Date: Wed, 5 Feb 2020 19:46:58 -0500 Subject: [PATCH 08/29] Rename Sketch effect to a ScopeGraph effect --- .../src/Language/Python/ScopeGraph.hs | 10 +++--- semantic-python/test-graphing/GraphTest.hs | 10 +++--- .../semantic-scope-graph.cabal | 4 +-- .../Sketch/{Fresh.hs => ScopeGraph.hs} | 8 ++--- .../Effect/{Sketch.hs => ScopeGraph.hs} | 31 ++++++++++--------- 5 files changed, 32 insertions(+), 31 deletions(-) rename semantic-scope-graph/src/Control/Carrier/Sketch/{Fresh.hs => ScopeGraph.hs} (92%) rename semantic-scope-graph/src/Control/Effect/{Sketch.hs => ScopeGraph.hs} (76%) diff --git a/semantic-python/src/Language/Python/ScopeGraph.hs b/semantic-python/src/Language/Python/ScopeGraph.hs index ab99cb2fe..e997b530a 100644 --- a/semantic-python/src/Language/Python/ScopeGraph.hs +++ b/semantic-python/src/Language/Python/ScopeGraph.hs @@ -26,7 +26,7 @@ import AST.Element import qualified Analysis.Name as Name import Control.Algebra (Algebra (..), handleCoercible) import Control.Effect.Fresh -import Control.Effect.Sketch +import Control.Effect.ScopeGraph import Data.Foldable import Data.Maybe import Data.Monoid @@ -49,7 +49,7 @@ instance Algebra sig m => Algebra sig (Ap m) where -- 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 diff --git a/semantic-python/test-graphing/GraphTest.hs b/semantic-python/test-graphing/GraphTest.hs index e915438fc..918d4a46e 100644 --- a/semantic-python/test-graphing/GraphTest.hs +++ b/semantic-python/test-graphing/GraphTest.hs @@ -51,7 +51,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" (DeclProperties ScopeGraph.Assignment ScopeGraph.Default Nothing) declare "goodbye" (DeclProperties ScopeGraph.Assignment ScopeGraph.Default Nothing) @@ -72,7 +72,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" (DeclProperties ScopeGraph.Assignment ScopeGraph.Default Nothing) reference "x" "x" RefProperties @@ -86,13 +86,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") (FunProperties ScopeGraph.Function) reference "foo" "foo" RefProperties {} pure Complete -expectedFunctionArg :: (Has Sketch sig m) => m Result +expectedFunctionArg :: (Has ScopeGraph sig m) => m Result expectedFunctionArg = do (_, associatedScope) <- declareFunction (Just $ Name.name "foo") (FunProperties ScopeGraph.Function) withScope associatedScope $ do @@ -102,7 +102,7 @@ expectedFunctionArg = do reference "foo" "foo" RefProperties pure Complete -expectedImportHole :: (Has Sketch sig m) => m Result +expectedImportHole :: (Has ScopeGraph sig m) => m Result expectedImportHole = do addImportEdge Import ["cheese", "ints"] diff --git a/semantic-scope-graph/semantic-scope-graph.cabal b/semantic-scope-graph/semantic-scope-graph.cabal index cf8f65f14..f7898fe8a 100644 --- a/semantic-scope-graph/semantic-scope-graph.cabal +++ b/semantic-scope-graph/semantic-scope-graph.cabal @@ -20,8 +20,8 @@ tested-with: GHC == 8.6.5 library exposed-modules: - Control.Carrier.Sketch.Fresh - Control.Effect.Sketch + Control.Carrier.Sketch.ScopeGraph + Control.Effect.ScopeGraph ScopeGraph.Convert Data.Hole Data.Module diff --git a/semantic-scope-graph/src/Control/Carrier/Sketch/Fresh.hs b/semantic-scope-graph/src/Control/Carrier/Sketch/ScopeGraph.hs similarity index 92% rename from semantic-scope-graph/src/Control/Carrier/Sketch/Fresh.hs rename to semantic-scope-graph/src/Control/Carrier/Sketch/ScopeGraph.hs index 8aad15695..99b21ba14 100644 --- a/semantic-scope-graph/src/Control/Carrier/Sketch/Fresh.hs +++ b/semantic-scope-graph/src/Control/Carrier/Sketch/ScopeGraph.hs @@ -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,7 +25,7 @@ import Control.Algebra import Control.Carrier.Fresh.Strict import Control.Carrier.State.Strict import Control.Carrier.Reader -import Control.Effect.Sketch +import Control.Effect.ScopeGraph (ScopeGraphEff(..), DeclProperties(..)) import Control.Monad.IO.Class import Data.Bifunctor import Data.Module @@ -56,7 +56,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 (new, _pos) = diff --git a/semantic-scope-graph/src/Control/Effect/Sketch.hs b/semantic-scope-graph/src/Control/Effect/ScopeGraph.hs similarity index 76% rename from semantic-scope-graph/src/Control/Effect/Sketch.hs rename to semantic-scope-graph/src/Control/Effect/ScopeGraph.hs index 2a4e0d2b8..ae9779c64 100644 --- a/semantic-scope-graph/src/Control/Effect/Sketch.hs +++ b/semantic-scope-graph/src/Control/Effect/ScopeGraph.hs @@ -8,12 +8,12 @@ {-# 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 (..) +-- physically ScopeGraphing the hierarchical outline of a graph. +module Control.Effect.ScopeGraph + ( ScopeGraph + , ScopeGraphEff (..) , DeclProperties (..) , RefProperties (..) , FunProperties (..) @@ -53,12 +53,12 @@ data FunProperties = FunProperties { kind :: ScopeGraph.Kind } -type Sketch - = SketchEff +type ScopeGraph + = ScopeGraphEff :+: Fresh :+: Reader Name -data SketchEff m k = +data ScopeGraphEff m k = Declare Name DeclProperties (() -> m k) | Reference Text Text RefProperties (() -> m k) | NewScope (Map ScopeGraph.EdgeLabel [Name]) (Name -> m k) @@ -68,20 +68,21 @@ data SketchEff m k = currentScope :: Has (Reader Name) sig m => m Name currentScope = ask -declare :: forall sig m . (Has Sketch sig m) => Name -> DeclProperties -> m () +declare :: forall sig m . Has ScopeGraph sig m => Name -> DeclProperties -> 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 -> RefProperties -> m () +reference :: forall sig m . Has ScopeGraph sig m => Text -> Text -> RefProperties -> 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) -insertEdge :: Has Sketch sig m => ScopeGraph.EdgeLabel -> NonEmpty Name -> m () +-- | 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 Sketch sig m) => Maybe Name -> FunProperties -> m (Name, Name) +declareFunction :: forall sig m . Has ScopeGraph sig m => Maybe Name -> FunProperties -> m (Name, Name) declareFunction name props = do currentScope' <- currentScope let lexicalEdges = Map.singleton ScopeGraph.Lexical [ currentScope' ] @@ -89,7 +90,7 @@ declareFunction name props = do name' <- declareMaybeName name (DeclProperties { relation = ScopeGraph.Default, kind = (getField @"kind" @FunProperties props), associatedScope = Just associatedScope }) pure (name', associatedScope) -declareMaybeName :: Has Sketch sig m +declareMaybeName :: Has ScopeGraph sig m => Maybe Name -> DeclProperties -> m Name @@ -98,7 +99,7 @@ declareMaybeName maybeName props = do Just name -> declare name props >> pure name _ -> Name.gensym >>= \name -> declare name (props { relation = ScopeGraph.Gensym }) >> pure name -- TODO: Modify props and change Kind to Gensym -withScope :: Has Sketch sig m +withScope :: Has ScopeGraph sig m => Name -> m a -> m a From 0c4e86cb11d3f66ebf9b4d781ad5fecf65ed9d6a Mon Sep 17 00:00:00 2001 From: joshvera Date: Wed, 5 Feb 2020 19:47:24 -0500 Subject: [PATCH 09/29] Call insertEdge in expectedImportHole --- semantic-python/test-graphing/GraphTest.hs | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/semantic-python/test-graphing/GraphTest.hs b/semantic-python/test-graphing/GraphTest.hs index 918d4a46e..9302db497 100644 --- a/semantic-python/test-graphing/GraphTest.hs +++ b/semantic-python/test-graphing/GraphTest.hs @@ -9,10 +9,11 @@ import Analysis.Name (Name) import qualified Analysis.Name as Name import Control.Algebra import Control.Carrier.Lift -import Control.Carrier.Sketch.Fresh +import Control.Carrier.Sketch.ScopeGraph +import Control.Effect.ScopeGraph +import qualified Data.ScopeGraph as ScopeGraph import Control.Monad import qualified Data.ByteString as ByteString -import qualified Data.ScopeGraph as ScopeGraph import qualified Language.Python () import qualified Language.Python as Py (Term) import ScopeGraph.Convert @@ -26,6 +27,7 @@ import qualified Test.Tasty as Tasty import qualified Test.Tasty.HUnit as HUnit import qualified TreeSitter.Python as TSP import qualified TreeSitter.Unmarshal as TS +import qualified Data.List.NonEmpty as NonEmpty {- @@ -104,9 +106,8 @@ expectedFunctionArg = do expectedImportHole :: (Has ScopeGraph sig m) => m Result expectedImportHole = do - addImportEdge Import ["cheese", "ints"] - - + insertEdge ScopeGraph.Import (NonEmpty.fromList ["chees", "ints"]) + pure Complete assertLexicalScope :: HUnit.Assertion assertLexicalScope = do From d023a5e007c2d79566c91eac1478cc34af77e57b Mon Sep 17 00:00:00 2001 From: joshvera Date: Wed, 5 Feb 2020 19:48:19 -0500 Subject: [PATCH 10/29] Set the last import hole label to Void --- semantic-scope-graph/src/Data/ScopeGraph.hs | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/semantic-scope-graph/src/Data/ScopeGraph.hs b/semantic-scope-graph/src/Data/ScopeGraph.hs index 520573b22..49e60a249 100644 --- a/semantic-scope-graph/src/Data/ScopeGraph.hs +++ b/semantic-scope-graph/src/Data/ScopeGraph.hs @@ -23,7 +23,6 @@ module Data.ScopeGraph , insertImportReference , newScope , newPreludeScope - , addImportHole , addImportEdge , insertScope , insertEdge @@ -359,16 +358,16 @@ insertEdge label target currentAddress g@(ScopeGraph graph) = fromMaybe g $ do addImportEdge :: Ord scopeAddress => EdgeLabel -> NonEmpty scopeAddress -> scopeAddress -> ScopeGraph scopeAddress -> ScopeGraph scopeAddress addImportEdge edge names currentAddress g = do case names of - (x :| []) -> addImportHole Import x currentAddress g + (x :| []) -> addImportHole x currentAddress g (x :| xs) -> do let scopeGraph' = newScope x mempty g addImportEdge edge (NonEmpty.fromList xs) x scopeGraph' -addImportHole :: Ord scopeAddress => EdgeLabel -> scopeAddress -> scopeAddress -> ScopeGraph scopeAddress -> ScopeGraph scopeAddress -addImportHole label name currentAddress g = fromMaybe g $ do +addImportHole :: Ord scopeAddress => scopeAddress -> scopeAddress -> ScopeGraph scopeAddress -> ScopeGraph scopeAddress +addImportHole name currentAddress g = fromMaybe g $ do let scope' = newScope name mempty g - pure (insertEdge label name currentAddress scope') + pure (insertEdge Void name currentAddress scope') -- | Update the 'Scope' containing a 'Declaration' with an associated scope address. @@ -446,5 +445,5 @@ 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 +data EdgeLabel = Lexical | Import | Void | Export | Superclass deriving (Bounded, Enum, Eq, Ord, Show) From c3c707cd6abaf8a9881322183bb2f2d47387e4d4 Mon Sep 17 00:00:00 2001 From: joshvera Date: Wed, 5 Feb 2020 19:49:32 -0500 Subject: [PATCH 11/29] Lookup scopes while adding import edges otherwise create intermediate scopes --- semantic-scope-graph/src/Data/ScopeGraph.hs | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/semantic-scope-graph/src/Data/ScopeGraph.hs b/semantic-scope-graph/src/Data/ScopeGraph.hs index 49e60a249..0fcfdfe83 100644 --- a/semantic-scope-graph/src/Data/ScopeGraph.hs +++ b/semantic-scope-graph/src/Data/ScopeGraph.hs @@ -360,8 +360,13 @@ addImportEdge edge names currentAddress g = do case names of (x :| []) -> addImportHole x currentAddress g (x :| xs) -> do - let scopeGraph' = newScope x mempty g - addImportEdge edge (NonEmpty.fromList xs) x scopeGraph' + case lookupScope x g of + Just _ -> addImportEdge edge (NonEmpty.fromList xs) x g + Nothing -> + let + scopeGraph' = insertEdge edge x currentAddress (newScope x mempty g) + in + addImportEdge edge (NonEmpty.fromList xs) x scopeGraph' addImportHole :: Ord scopeAddress => scopeAddress -> scopeAddress -> ScopeGraph scopeAddress -> ScopeGraph scopeAddress From 5044f41e41673210ca789bedc29d681086a1aff9 Mon Sep 17 00:00:00 2001 From: joshvera Date: Wed, 5 Feb 2020 19:49:39 -0500 Subject: [PATCH 12/29] lookupReference docs --- semantic-scope-graph/src/Data/ScopeGraph.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/semantic-scope-graph/src/Data/ScopeGraph.hs b/semantic-scope-graph/src/Data/ScopeGraph.hs index 0fcfdfe83..1c8fcc547 100644 --- a/semantic-scope-graph/src/Data/ScopeGraph.hs +++ b/semantic-scope-graph/src/Data/ScopeGraph.hs @@ -345,7 +345,8 @@ putDeclarationScopeAtPosition scope position assocScope g@(ScopeGraph graph) = f 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) +-- | 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 From b8eaf61863dca9af6d0196f49302f559cd81a36f Mon Sep 17 00:00:00 2001 From: joshvera Date: Wed, 5 Feb 2020 19:49:50 -0500 Subject: [PATCH 13/29] Rename effect to ScopeGraph --- semantic-scope-graph/src/ScopeGraph/Convert.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/semantic-scope-graph/src/ScopeGraph/Convert.hs b/semantic-scope-graph/src/ScopeGraph/Convert.hs index 4149cea9b..33a96ac89 100644 --- a/semantic-scope-graph/src/ScopeGraph/Convert.hs +++ b/semantic-scope-graph/src/ScopeGraph/Convert.hs @@ -13,14 +13,14 @@ module ScopeGraph.Convert , 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 From d8bad61c1f7c66cd837d09b1f6161b74bced8307 Mon Sep 17 00:00:00 2001 From: joshvera Date: Wed, 5 Feb 2020 19:52:47 -0500 Subject: [PATCH 14/29] fix tests --- semantic-python/test-graphing/GraphTest.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/semantic-python/test-graphing/GraphTest.hs b/semantic-python/test-graphing/GraphTest.hs index 9302db497..ffb043c6c 100644 --- a/semantic-python/test-graphing/GraphTest.hs +++ b/semantic-python/test-graphing/GraphTest.hs @@ -106,7 +106,7 @@ expectedFunctionArg = do expectedImportHole :: (Has ScopeGraph sig m) => m Result expectedImportHole = do - insertEdge ScopeGraph.Import (NonEmpty.fromList ["chees", "ints"]) + insertEdge ScopeGraph.Import (NonEmpty.fromList ["cheese", "ints"]) pure Complete assertLexicalScope :: HUnit.Assertion From 596ac8da54a0e0edf00e6381340e4d794dffca60 Mon Sep 17 00:00:00 2001 From: joshvera Date: Wed, 5 Feb 2020 20:44:04 -0500 Subject: [PATCH 15/29] Label the edge to the import instead of the last hole --- .../src/Control/Carrier/Sketch/ScopeGraph.hs | 3 +- semantic-scope-graph/src/Data/ScopeGraph.hs | 31 ++++++++++--------- 2 files changed, 18 insertions(+), 16 deletions(-) diff --git a/semantic-scope-graph/src/Control/Carrier/Sketch/ScopeGraph.hs b/semantic-scope-graph/src/Control/Carrier/Sketch/ScopeGraph.hs index 99b21ba14..6a2e36958 100644 --- a/semantic-scope-graph/src/Control/Carrier/Sketch/ScopeGraph.hs +++ b/semantic-scope-graph/src/Control/Carrier/Sketch/ScopeGraph.hs @@ -35,6 +35,7 @@ import Data.Semilattice.Lower import GHC.Records import Source.Span import qualified System.Path as Path +import qualified Data.List.NonEmpty as NonEmpty -- | The state type used to keep track of the in-progress graph and -- positional/contextual information. The name "sketchbook" is meant @@ -93,7 +94,7 @@ instance (Effect sig, Algebra sig m) => Algebra (ScopeGraphEff :+: Reader Name : k name alg (L (InsertEdge label address k)) = do Sketchbook old current <- SketchC get - let new = ScopeGraph.addImportEdge label address current old + let new = ScopeGraph.addImportEdge label (NonEmpty.toList address) current old SketchC (put (Sketchbook new current)) k () diff --git a/semantic-scope-graph/src/Data/ScopeGraph.hs b/semantic-scope-graph/src/Data/ScopeGraph.hs index 1c8fcc547..7bee1c259 100644 --- a/semantic-scope-graph/src/Data/ScopeGraph.hs +++ b/semantic-scope-graph/src/Data/ScopeGraph.hs @@ -356,24 +356,25 @@ insertEdge label target currentAddress g@(ScopeGraph graph) = fromMaybe g $ do let newScope = currentScope' { edges = Map.insert label (target : scopes) (edges currentScope') } pure (ScopeGraph (Map.insert currentAddress newScope graph)) -addImportEdge :: Ord scopeAddress => EdgeLabel -> NonEmpty scopeAddress -> scopeAddress -> ScopeGraph scopeAddress -> ScopeGraph scopeAddress -addImportEdge edge names currentAddress g = do - case names of - (x :| []) -> addImportHole x currentAddress g - (x :| xs) -> do - case lookupScope x g of - Just _ -> addImportEdge edge (NonEmpty.fromList xs) x g - Nothing -> - let - scopeGraph' = insertEdge edge x currentAddress (newScope x mempty g) - in - addImportEdge edge (NonEmpty.fromList xs) x scopeGraph' - +addImportEdge :: Ord scopeAddress => EdgeLabel -> [scopeAddress] -> scopeAddress -> ScopeGraph scopeAddress -> ScopeGraph scopeAddress +addImportEdge edge importEdge currentAddress g = do + case importEdge of + (name:[]) -> maybe + (insertEdge edge name currentAddress (newScope name mempty g)) + (const (insertEdge edge name currentAddress g)) + (lookupScope name g) + (name:names) -> let + scopeGraph' = maybe + (insertEdge VoidL name currentAddress (newScope name mempty g)) + (const (insertEdge edge name currentAddress g)) + (lookupScope name g) + in + addImportEdge edge names name scopeGraph' addImportHole :: Ord scopeAddress => scopeAddress -> scopeAddress -> ScopeGraph scopeAddress -> ScopeGraph scopeAddress addImportHole name currentAddress g = fromMaybe g $ do let scope' = newScope name mempty g - pure (insertEdge Void name currentAddress scope') + pure (insertEdge VoidL name currentAddress scope') -- | Update the 'Scope' containing a 'Declaration' with an associated scope address. @@ -451,5 +452,5 @@ 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 | Void | Export | Superclass +data EdgeLabel = Lexical | Import | Export | Superclass | VoidL deriving (Bounded, Enum, Eq, Ord, Show) From 34186bced76d5d33be5ce71f41d33bedfc1ee812 Mon Sep 17 00:00:00 2001 From: joshvera Date: Wed, 5 Feb 2020 21:00:11 -0500 Subject: [PATCH 16/29] Remove sketches --- .../test/fixtures/cheese/6-01-imports.py | 22 ------------------- 1 file changed, 22 deletions(-) diff --git a/semantic-python/test/fixtures/cheese/6-01-imports.py b/semantic-python/test/fixtures/cheese/6-01-imports.py index c97dee19a..5ce8582d6 100644 --- a/semantic-python/test/fixtures/cheese/6-01-imports.py +++ b/semantic-python/test/fixtures/cheese/6-01-imports.py @@ -1,23 +1 @@ from cheese.ints import * - -# EPath Import currentScope (Hole (cheese, ints)) - - -# data Scope address = Scope -# { edges :: Map EdgeLabel [address] -# , references :: Map Reference ([ReferenceInfo], Path address) -# , partialPaths :: Path address -# , declarations :: Seq (Info address) -# , domain :: Domain - - -# data Path scope -# = Hole (NonEmpty Name) -# -- | 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) - -# Scope -# references = Map (Reference one) From 66ee2cf54dff9f76f6b98700052b4a7a8154584c Mon Sep 17 00:00:00 2001 From: joshvera Date: Wed, 5 Feb 2020 21:04:03 -0500 Subject: [PATCH 17/29] use addImportHole internally --- semantic-scope-graph/src/Data/ScopeGraph.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/semantic-scope-graph/src/Data/ScopeGraph.hs b/semantic-scope-graph/src/Data/ScopeGraph.hs index 7bee1c259..7e8c8f824 100644 --- a/semantic-scope-graph/src/Data/ScopeGraph.hs +++ b/semantic-scope-graph/src/Data/ScopeGraph.hs @@ -365,7 +365,7 @@ addImportEdge edge importEdge currentAddress g = do (lookupScope name g) (name:names) -> let scopeGraph' = maybe - (insertEdge VoidL name currentAddress (newScope name mempty g)) + (addImportHole name currentAddress g) (const (insertEdge edge name currentAddress g)) (lookupScope name g) in From a47186f38de00c51cdd56ee2c3cd8d29e1617664 Mon Sep 17 00:00:00 2001 From: joshvera Date: Wed, 5 Feb 2020 21:06:58 -0500 Subject: [PATCH 18/29] add a base case for importEdge --- semantic-scope-graph/src/Data/ScopeGraph.hs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/semantic-scope-graph/src/Data/ScopeGraph.hs b/semantic-scope-graph/src/Data/ScopeGraph.hs index 7e8c8f824..c53a9f9c9 100644 --- a/semantic-scope-graph/src/Data/ScopeGraph.hs +++ b/semantic-scope-graph/src/Data/ScopeGraph.hs @@ -71,8 +71,6 @@ import qualified Data.Set as Set import Data.Text (Text) import GHC.Generics import Source.Span -import Data.List.NonEmpty (NonEmpty(..)) -import qualified Data.List.NonEmpty as NonEmpty -- A slot is a location in the heap where a value is stored. data Slot address = Slot { frameAddress :: address, position :: Position } @@ -359,6 +357,7 @@ insertEdge label target currentAddress g@(ScopeGraph graph) = fromMaybe g $ do addImportEdge :: Ord scopeAddress => EdgeLabel -> [scopeAddress] -> scopeAddress -> ScopeGraph scopeAddress -> ScopeGraph scopeAddress addImportEdge edge importEdge currentAddress g = do case importEdge of + [] -> g (name:[]) -> maybe (insertEdge edge name currentAddress (newScope name mempty g)) (const (insertEdge edge name currentAddress g)) From 0bc0a638b356fa48202f37aa0e3dde8c5b1bd5a9 Mon Sep 17 00:00:00 2001 From: joshvera Date: Wed, 5 Feb 2020 21:11:15 -0500 Subject: [PATCH 19/29] document addImportEdge --- semantic-scope-graph/src/Data/ScopeGraph.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/semantic-scope-graph/src/Data/ScopeGraph.hs b/semantic-scope-graph/src/Data/ScopeGraph.hs index c53a9f9c9..d04c195d2 100644 --- a/semantic-scope-graph/src/Data/ScopeGraph.hs +++ b/semantic-scope-graph/src/Data/ScopeGraph.hs @@ -354,6 +354,8 @@ insertEdge label target currentAddress g@(ScopeGraph graph) = fromMaybe g $ do let newScope = currentScope' { edges = Map.insert label (target : scopes) (edges currentScope') } pure (ScopeGraph (Map.insert currentAddress newScope graph)) +-- | Add an import edge of the form 'a -> Import -> b -> Import -> c' or creates intermediate void scopes of the form +-- 'a -> VoidL -> 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 From 1036b3a4d7ba32bd4c75669a38505a76203837ff Mon Sep 17 00:00:00 2001 From: joshvera Date: Wed, 5 Feb 2020 21:29:37 -0500 Subject: [PATCH 20/29] addImportHole adds an additional VoidL edge --- semantic-scope-graph/src/Data/ScopeGraph.hs | 19 +++++++++++++------ 1 file changed, 13 insertions(+), 6 deletions(-) diff --git a/semantic-scope-graph/src/Data/ScopeGraph.hs b/semantic-scope-graph/src/Data/ScopeGraph.hs index d04c195d2..92261ed58 100644 --- a/semantic-scope-graph/src/Data/ScopeGraph.hs +++ b/semantic-scope-graph/src/Data/ScopeGraph.hs @@ -71,6 +71,8 @@ import qualified Data.Set as Set import Data.Text (Text) import GHC.Generics import Source.Span +import Data.List.NonEmpty (NonEmpty) +import qualified Data.List.NonEmpty as NonEmpty -- A slot is a location in the heap where a value is stored. data Slot address = Slot { frameAddress :: address, position :: Position } @@ -354,6 +356,10 @@ insertEdge label target currentAddress g@(ScopeGraph graph) = fromMaybe g $ do 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 -> VoidL -> b -> Import -> c' if the given scopes cannot be found. addImportEdge :: Ord scopeAddress => EdgeLabel -> [scopeAddress] -> scopeAddress -> ScopeGraph scopeAddress -> ScopeGraph scopeAddress @@ -361,21 +367,22 @@ addImportEdge edge importEdge currentAddress g = do case importEdge of [] -> g (name:[]) -> maybe - (insertEdge edge name currentAddress (newScope name mempty g)) + (addImportHole edge name currentAddress g) (const (insertEdge edge name currentAddress g)) (lookupScope name g) (name:names) -> let scopeGraph' = maybe - (addImportHole name currentAddress g) + (addImportHole edge name currentAddress g) (const (insertEdge edge name currentAddress g)) (lookupScope name g) in addImportEdge edge names name scopeGraph' -addImportHole :: Ord scopeAddress => scopeAddress -> scopeAddress -> ScopeGraph scopeAddress -> ScopeGraph scopeAddress -addImportHole name currentAddress g = fromMaybe g $ do - let scope' = newScope name mempty g - pure (insertEdge VoidL name currentAddress scope') +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 [VoidL, edge]) name currentAddress scopeGraph' -- | Update the 'Scope' containing a 'Declaration' with an associated scope address. From a8871b69ebf25825f266fe877c8a7669ba2a16fe Mon Sep 17 00:00:00 2001 From: joshvera Date: Thu, 6 Feb 2020 14:53:41 -0500 Subject: [PATCH 21/29] stylish-haskell --- semantic-scope-graph/src/Data/ScopeGraph.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/semantic-scope-graph/src/Data/ScopeGraph.hs b/semantic-scope-graph/src/Data/ScopeGraph.hs index 92261ed58..d6168fc25 100644 --- a/semantic-scope-graph/src/Data/ScopeGraph.hs +++ b/semantic-scope-graph/src/Data/ScopeGraph.hs @@ -58,6 +58,8 @@ import Data.Bifunctor import Data.Foldable import Data.Hashable import Data.Hole +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 @@ -71,8 +73,6 @@ import qualified Data.Set as Set import Data.Text (Text) import GHC.Generics import Source.Span -import Data.List.NonEmpty (NonEmpty) -import qualified Data.List.NonEmpty as NonEmpty -- A slot is a location in the heap where a value is stored. data Slot address = Slot { frameAddress :: address, position :: Position } From 07c944eb8e5f468f8e215aa3a638f5b8ffbcb94f Mon Sep 17 00:00:00 2001 From: joshvera Date: Thu, 6 Feb 2020 15:21:02 -0500 Subject: [PATCH 22/29] remove import --- semantic-python/src/Language/Python.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/semantic-python/src/Language/Python.hs b/semantic-python/src/Language/Python.hs index 80460e7d5..59abf0d09 100644 --- a/semantic-python/src/Language/Python.hs +++ b/semantic-python/src/Language/Python.hs @@ -10,7 +10,6 @@ import Language.Python.ScopeGraph import qualified Language.Python.Tags as PyTags import ScopeGraph.Convert import qualified Tags.Tagging.Precise as Tags -import qualified TreeSitter.Python.AST as Py import qualified Language.Python.Grammar (tree_sitter_python) import qualified AST.Unmarshal as TS From c3dac243c2b30baf2fcbcf5c29721bd3b46f3e8d Mon Sep 17 00:00:00 2001 From: joshvera Date: Thu, 6 Feb 2020 15:30:27 -0500 Subject: [PATCH 23/29] remove redundant import --- semantic-python/test-graphing/GraphTest.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/semantic-python/test-graphing/GraphTest.hs b/semantic-python/test-graphing/GraphTest.hs index 073c4c448..ee9eabc93 100644 --- a/semantic-python/test-graphing/GraphTest.hs +++ b/semantic-python/test-graphing/GraphTest.hs @@ -16,7 +16,6 @@ import Control.Monad import qualified Data.ByteString as ByteString import qualified Data.List.NonEmpty as NonEmpty import qualified Data.ScopeGraph as ScopeGraph -import qualified Data.ScopeGraph as ScopeGraph import Data.Semilattice.Lower import qualified Language.Python () import qualified Language.Python as Py (Term) From ff3e6973f97627a76264dc6325a00c7e2c35a7f4 Mon Sep 17 00:00:00 2001 From: joshvera Date: Thu, 6 Feb 2020 15:33:18 -0500 Subject: [PATCH 24/29] also redundant --- semantic-scope-graph/src/Control/Effect/ScopeGraph.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/semantic-scope-graph/src/Control/Effect/ScopeGraph.hs b/semantic-scope-graph/src/Control/Effect/ScopeGraph.hs index 8633c03a4..520737511 100644 --- a/semantic-scope-graph/src/Control/Effect/ScopeGraph.hs +++ b/semantic-scope-graph/src/Control/Effect/ScopeGraph.hs @@ -36,7 +36,6 @@ import qualified Data.Map.Strict as Map import qualified Data.ScopeGraph as ScopeGraph import Data.Text (Text) import GHC.Generics (Generic, Generic1) -import GHC.Records import Data.List.NonEmpty import qualified ScopeGraph.Properties.Declaration as Props From 7aa975624a2f6b52bdc70ad05de726fe942e54bf Mon Sep 17 00:00:00 2001 From: joshvera Date: Thu, 6 Feb 2020 15:49:34 -0500 Subject: [PATCH 25/29] bump the store --- .github/workflows/haskell.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/haskell.yml b/.github/workflows/haskell.yml index 0aa41d2aa..d53964c73 100644 --- a/.github/workflows/haskell.yml +++ b/.github/workflows/haskell.yml @@ -37,7 +37,7 @@ jobs: name: Cache ~/.cabal/store with: path: ~/.cabal/store - key: ${{ runner.os }}-${{ matrix.ghc }}-v8-cabal-store + key: ${{ runner.os }}-${{ matrix.ghc }}-v9-cabal-store - uses: actions/cache@v1 name: Cache dist-newstyle From 58198d5647e5c5a6d9f3fb15b57c7ad8a1350b66 Mon Sep 17 00:00:00 2001 From: joshvera Date: Thu, 6 Feb 2020 17:39:37 -0500 Subject: [PATCH 26/29] remove L suffix from EdgeLabel.Void --- semantic-scope-graph/src/Data/ScopeGraph.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/semantic-scope-graph/src/Data/ScopeGraph.hs b/semantic-scope-graph/src/Data/ScopeGraph.hs index d6168fc25..aeca20d64 100644 --- a/semantic-scope-graph/src/Data/ScopeGraph.hs +++ b/semantic-scope-graph/src/Data/ScopeGraph.hs @@ -361,7 +361,7 @@ 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 -> VoidL -> b -> Import -> c' if the given scopes cannot be found. +-- '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 @@ -382,7 +382,7 @@ addImportHole :: Ord scopeAddress => EdgeLabel -> scopeAddress -> scopeAddress - addImportHole edge name currentAddress g = let scopeGraph' = newScope name mempty g in - insertEdges (NonEmpty.fromList [VoidL, edge]) name currentAddress scopeGraph' + insertEdges (NonEmpty.fromList [Void, edge]) name currentAddress scopeGraph' -- | Update the 'Scope' containing a 'Declaration' with an associated scope address. @@ -460,5 +460,5 @@ 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 | VoidL +data EdgeLabel = Lexical | Import | Export | Superclass | Void deriving (Bounded, Enum, Eq, Ord, Show) From 317c0c14739454e6cc1f12fbbee8ffcd716b2003 Mon Sep 17 00:00:00 2001 From: joshvera Date: Fri, 7 Feb 2020 10:53:20 -0500 Subject: [PATCH 27/29] stub in other cases --- semantic-python/src/Language/Python/ScopeGraph.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/semantic-python/src/Language/Python/ScopeGraph.hs b/semantic-python/src/Language/Python/ScopeGraph.hs index 31f794974..253455c92 100644 --- a/semantic-python/src/Language/Python/ScopeGraph.hs +++ b/semantic-python/src/Language/Python/ScopeGraph.hs @@ -235,6 +235,7 @@ 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) From 1aab661b0f000f3df4bb9bfacb721f1de7565a8f Mon Sep 17 00:00:00 2001 From: joshvera Date: Fri, 7 Feb 2020 12:28:21 -0500 Subject: [PATCH 28/29] fix Void conflicts --- src/Data/Abstract/Value/Type.hs | 2 +- src/Data/Syntax/Expression.hs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Data/Abstract/Value/Type.hs b/src/Data/Abstract/Value/Type.hs index ed1c77bde..73a828331 100644 --- a/src/Data/Abstract/Value/Type.hs +++ b/src/Data/Abstract/Value/Type.hs @@ -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 diff --git a/src/Data/Syntax/Expression.hs b/src/Data/Syntax/Expression.hs index bf5915f49..486401303 100644 --- a/src/Data/Syntax/Expression.hs +++ b/src/Data/Syntax/Expression.hs @@ -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 From 06e8c6ecaa4a4c7c566db3c0c3fdbb5ed992baca Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Fri, 7 Feb 2020 15:08:33 -0500 Subject: [PATCH 29/29] Break up Data.ScopeGraph and reorg semantic-scope-graph. --- semantic-python/src/Language/Python.hs | 6 +- .../src/Language/Python/ScopeGraph.hs | 8 +- semantic-python/test-graphing/GraphTest.hs | 8 +- .../semantic-scope-graph.cabal | 14 +- .../src/Control/Carrier/Sketch/ScopeGraph.hs | 2 +- .../src/Control/Effect/ScopeGraph.hs | 8 +- .../ScopeGraph/Properties/Declaration.hs | 2 +- .../Effect}/ScopeGraph/Properties/Function.hs | 2 +- .../ScopeGraph/Properties/Reference.hs | 2 +- semantic-scope-graph/src/Data/ScopeGraph.hs | 471 +----------------- .../src/Scope/Graph/AdjacencyList.hs | 249 +++++++++ .../{ScopeGraph => Scope/Graph}/Convert.hs | 2 +- semantic-scope-graph/src/Scope/Info.hs | 61 +++ semantic-scope-graph/src/Scope/Path.hs | 41 ++ semantic-scope-graph/src/Scope/Reference.hs | 28 ++ semantic-scope-graph/src/Scope/Scope.hs | 30 ++ semantic-scope-graph/src/Scope/Types.hs | 94 ++++ 17 files changed, 543 insertions(+), 485 deletions(-) rename semantic-scope-graph/src/{ => Control/Effect}/ScopeGraph/Properties/Declaration.hs (93%) rename semantic-scope-graph/src/{ => Control/Effect}/ScopeGraph/Properties/Function.hs (92%) rename semantic-scope-graph/src/{ => Control/Effect}/ScopeGraph/Properties/Reference.hs (86%) create mode 100644 semantic-scope-graph/src/Scope/Graph/AdjacencyList.hs rename semantic-scope-graph/src/{ScopeGraph => Scope/Graph}/Convert.hs (97%) create mode 100644 semantic-scope-graph/src/Scope/Info.hs create mode 100644 semantic-scope-graph/src/Scope/Path.hs create mode 100644 semantic-scope-graph/src/Scope/Reference.hs create mode 100644 semantic-scope-graph/src/Scope/Scope.hs create mode 100644 semantic-scope-graph/src/Scope/Types.hs diff --git a/semantic-python/src/Language/Python.hs b/semantic-python/src/Language/Python.hs index 59abf0d09..54745db1d 100644 --- a/semantic-python/src/Language/Python.hs +++ b/semantic-python/src/Language/Python.hs @@ -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 } diff --git a/semantic-python/src/Language/Python/ScopeGraph.hs b/semantic-python/src/Language/Python/ScopeGraph.hs index 253455c92..f4e89a96e 100644 --- a/semantic-python/src/Language/Python/ScopeGraph.hs +++ b/semantic-python/src/Language/Python/ScopeGraph.hs @@ -25,6 +25,9 @@ import qualified Analysis.Name as Name import AST.Element import Control.Effect.Fresh 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_) diff --git a/semantic-python/test-graphing/GraphTest.hs b/semantic-python/test-graphing/GraphTest.hs index ee9eabc93..38c3a0344 100644 --- a/semantic-python/test-graphing/GraphTest.hs +++ b/semantic-python/test-graphing/GraphTest.hs @@ -12,6 +12,9 @@ import Control.Algebra import Control.Carrier.Lift 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 @@ -20,10 +23,7 @@ import Data.Semilattice.Lower import qualified Language.Python () import qualified Language.Python as Py (Term) import qualified Language.Python.Grammar as TSP -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 Scope.Graph.Convert import Source.Loc import qualified Source.Source as Source import Source.Span diff --git a/semantic-scope-graph/semantic-scope-graph.cabal b/semantic-scope-graph/semantic-scope-graph.cabal index 1839294ef..51c9b908a 100644 --- a/semantic-scope-graph/semantic-scope-graph.cabal +++ b/semantic-scope-graph/semantic-scope-graph.cabal @@ -22,10 +22,16 @@ library exposed-modules: Control.Carrier.Sketch.ScopeGraph Control.Effect.ScopeGraph - ScopeGraph.Convert - ScopeGraph.Properties.Declaration - ScopeGraph.Properties.Function - ScopeGraph.Properties.Reference + 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 diff --git a/semantic-scope-graph/src/Control/Carrier/Sketch/ScopeGraph.hs b/semantic-scope-graph/src/Control/Carrier/Sketch/ScopeGraph.hs index a379b12ee..a5b11cbb5 100644 --- a/semantic-scope-graph/src/Control/Carrier/Sketch/ScopeGraph.hs +++ b/semantic-scope-graph/src/Control/Carrier/Sketch/ScopeGraph.hs @@ -26,6 +26,7 @@ import Control.Carrier.Fresh.Strict import Control.Carrier.Reader import Control.Carrier.State.Strict 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 @@ -33,7 +34,6 @@ 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 diff --git a/semantic-scope-graph/src/Control/Effect/ScopeGraph.hs b/semantic-scope-graph/src/Control/Effect/ScopeGraph.hs index 520737511..7774c9c0b 100644 --- a/semantic-scope-graph/src/Control/Effect/ScopeGraph.hs +++ b/semantic-scope-graph/src/Control/Effect/ScopeGraph.hs @@ -31,16 +31,16 @@ 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 Data.List.NonEmpty -import qualified ScopeGraph.Properties.Declaration as Props -import qualified ScopeGraph.Properties.Function as Props -import qualified ScopeGraph.Properties.Reference as Props +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 diff --git a/semantic-scope-graph/src/ScopeGraph/Properties/Declaration.hs b/semantic-scope-graph/src/Control/Effect/ScopeGraph/Properties/Declaration.hs similarity index 93% rename from semantic-scope-graph/src/ScopeGraph/Properties/Declaration.hs rename to semantic-scope-graph/src/Control/Effect/ScopeGraph/Properties/Declaration.hs index 3ea7aca37..96ac1bc1c 100644 --- a/semantic-scope-graph/src/ScopeGraph/Properties/Declaration.hs +++ b/semantic-scope-graph/src/Control/Effect/ScopeGraph/Properties/Declaration.hs @@ -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 diff --git a/semantic-scope-graph/src/ScopeGraph/Properties/Function.hs b/semantic-scope-graph/src/Control/Effect/ScopeGraph/Properties/Function.hs similarity index 92% rename from semantic-scope-graph/src/ScopeGraph/Properties/Function.hs rename to semantic-scope-graph/src/Control/Effect/ScopeGraph/Properties/Function.hs index 9146455b8..50d56356b 100644 --- a/semantic-scope-graph/src/ScopeGraph/Properties/Function.hs +++ b/semantic-scope-graph/src/Control/Effect/ScopeGraph/Properties/Function.hs @@ -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 diff --git a/semantic-scope-graph/src/ScopeGraph/Properties/Reference.hs b/semantic-scope-graph/src/Control/Effect/ScopeGraph/Properties/Reference.hs similarity index 86% rename from semantic-scope-graph/src/ScopeGraph/Properties/Reference.hs rename to semantic-scope-graph/src/Control/Effect/ScopeGraph/Properties/Reference.hs index 84f598efe..ab0b92e38 100644 --- a/semantic-scope-graph/src/ScopeGraph/Properties/Reference.hs +++ b/semantic-scope-graph/src/Control/Effect/ScopeGraph/Properties/Reference.hs @@ -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 diff --git a/semantic-scope-graph/src/Data/ScopeGraph.hs b/semantic-scope-graph/src/Data/ScopeGraph.hs index aeca20d64..e85e3931b 100644 --- a/semantic-scope-graph/src/Data/ScopeGraph.hs +++ b/semantic-scope-graph/src/Data/ScopeGraph.hs @@ -1,464 +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 - , addImportEdge - , 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.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 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) - --- | 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) <|>) - -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 | Void - deriving (Bounded, Enum, Eq, Ord, Show) +import Scope.Graph.AdjacencyList +import Scope.Info +import Scope.Path +import Scope.Scope +import Scope.Types diff --git a/semantic-scope-graph/src/Scope/Graph/AdjacencyList.hs b/semantic-scope-graph/src/Scope/Graph/AdjacencyList.hs new file mode 100644 index 000000000..a585ee5ec --- /dev/null +++ b/semantic-scope-graph/src/Scope/Graph/AdjacencyList.hs @@ -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) <|>) diff --git a/semantic-scope-graph/src/ScopeGraph/Convert.hs b/semantic-scope-graph/src/Scope/Graph/Convert.hs similarity index 97% rename from semantic-scope-graph/src/ScopeGraph/Convert.hs rename to semantic-scope-graph/src/Scope/Graph/Convert.hs index 33a96ac89..b0303518e 100644 --- a/semantic-scope-graph/src/ScopeGraph/Convert.hs +++ b/semantic-scope-graph/src/Scope/Graph/Convert.hs @@ -6,7 +6,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeOperators #-} -module ScopeGraph.Convert +module Scope.Graph.Convert ( ToScopeGraph (..) , Result (..) , todo diff --git a/semantic-scope-graph/src/Scope/Info.hs b/semantic-scope-graph/src/Scope/Info.hs new file mode 100644 index 000000000..c735b0ab9 --- /dev/null +++ b/semantic-scope-graph/src/Scope/Info.hs @@ -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 + + diff --git a/semantic-scope-graph/src/Scope/Path.hs b/semantic-scope-graph/src/Scope/Path.hs new file mode 100644 index 000000000..a39e0ae00 --- /dev/null +++ b/semantic-scope-graph/src/Scope/Path.hs @@ -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 diff --git a/semantic-scope-graph/src/Scope/Reference.hs b/semantic-scope-graph/src/Scope/Reference.hs new file mode 100644 index 000000000..2b267f9c3 --- /dev/null +++ b/semantic-scope-graph/src/Scope/Reference.hs @@ -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 "" diff --git a/semantic-scope-graph/src/Scope/Scope.hs b/semantic-scope-graph/src/Scope/Scope.hs new file mode 100644 index 000000000..8d4947c61 --- /dev/null +++ b/semantic-scope-graph/src/Scope/Scope.hs @@ -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 diff --git a/semantic-scope-graph/src/Scope/Types.hs b/semantic-scope-graph/src/Scope/Types.hs new file mode 100644 index 000000000..45e1e9441 --- /dev/null +++ b/semantic-scope-graph/src/Scope/Types.hs @@ -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