From 06e8c6ecaa4a4c7c566db3c0c3fdbb5ed992baca Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Fri, 7 Feb 2020 15:08:33 -0500 Subject: [PATCH] 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