Merge branch 'master' into codegen-migration-leftovers

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"

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 }
 

semantic-python/src/Language/Python/ScopeGraph.hs

@@ -24,7 +24,10 @@ module Language.Python.ScopeGraph
 import qualified Analysis.Name as Name
 import           AST.Element
 import           Control.Effect.Fresh
-import           Control.Effect.Sketch
+import           Control.Effect.ScopeGraph
+import qualified Control.Effect.ScopeGraph.Properties.Declaration as Props
+import qualified Control.Effect.ScopeGraph.Properties.Function as Props
+import qualified Control.Effect.ScopeGraph.Properties.Reference as Props
 import           Control.Lens (set, (^.))
 import           Data.Foldable
 import           Data.Maybe
@@ -36,10 +39,7 @@ import           GHC.Records
 import           GHC.TypeLits
 import qualified Language.Python.AST as Py
 import           Language.Python.Patterns
-import           ScopeGraph.Convert (Result (..), complete, todo)
+import           Scope.Graph.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           Source.Loc
 import           Source.Span (span_)
 
@@ -49,7 +49,7 @@ import           Source.Span (span_)
 -- every single Python AST type.
 class (forall a . Show a => Show (t a)) => ToScopeGraph t where
   scopeGraph ::
-    ( Has Sketch sig m
+    ( Has ScopeGraph sig m
     , Monoid (m Result)
     )
     => t Loc
@@ -61,7 +61,7 @@ instance (ToScopeGraph l, ToScopeGraph r) => ToScopeGraph (l :+: r) where
 
 onField ::
   forall (field :: Symbol) syn sig m r .
-  ( Has Sketch sig m
+  ( Has ScopeGraph sig m
   , HasField field (r Loc) (syn Loc)
   , ToScopeGraph syn
   , Monoid (m Result)
@@ -75,7 +75,7 @@ onField
 onChildren ::
   ( Traversable t
   , ToScopeGraph syn
-  , Has Sketch sig m
+  , Has ScopeGraph sig m
   , HasField "extraChildren" (r Loc) (t (syn Loc))
   , Monoid (m Result)
   )
@@ -86,7 +86,7 @@ onChildren
   . traverse scopeGraph
   . getField @"extraChildren"
 
-scopeGraphModule :: Has Sketch sig m => Py.Module Loc -> m Result
+scopeGraphModule :: Has ScopeGraph sig m => Py.Module Loc -> m Result
 scopeGraphModule = getAp . scopeGraph
 
 instance ToScopeGraph Py.AssertStatement where scopeGraph = onChildren
@@ -231,7 +231,13 @@ instance ToScopeGraph Py.Integer where scopeGraph = mempty
 
 instance ToScopeGraph Py.ImportStatement where scopeGraph = todo
 
-instance ToScopeGraph Py.ImportFromStatement where scopeGraph = todo
+instance ToScopeGraph Py.ImportFromStatement where
+  scopeGraph (Py.ImportFromStatement _ [] (L1 (Py.DottedName _ names)) (Just (Py.WildcardImport _ _))) = do
+    let toName (Py.Identifier _ name) = Name.name name
+    complete <* insertEdge ScopeGraph.Import (toName <$> names)
+  scopeGraph term = todo (show term)
+
+
 
 instance ToScopeGraph Py.Lambda where scopeGraph = todo
 

semantic-python/test-graphing/GraphTest.hs

@@ -7,19 +7,23 @@ module Main (main) where
 
 import           Analysis.Name (Name)
 import qualified Analysis.Name as Name
+import qualified AST.Unmarshal as TS
 import           Control.Algebra
 import           Control.Carrier.Lift
-import           Control.Carrier.Sketch.Fresh
+import           Control.Carrier.Sketch.ScopeGraph
+import           Control.Effect.ScopeGraph
+import qualified Control.Effect.ScopeGraph.Properties.Declaration as Props
+import qualified Control.Effect.ScopeGraph.Properties.Function as Props
+import qualified Control.Effect.ScopeGraph.Properties.Reference as Props
 import           Control.Monad
 import qualified Data.ByteString as ByteString
+import qualified Data.List.NonEmpty as NonEmpty
 import qualified Data.ScopeGraph as ScopeGraph
 import           Data.Semilattice.Lower
 import qualified Language.Python ()
 import qualified Language.Python as Py (Term)
-import           ScopeGraph.Convert
+import qualified Language.Python.Grammar as TSP
-import qualified ScopeGraph.Properties.Declaration as Props
+import           Scope.Graph.Convert
-import qualified ScopeGraph.Properties.Function as Props
-import qualified ScopeGraph.Properties.Reference as Props
 import           Source.Loc
 import qualified Source.Source as Source
 import           Source.Span
@@ -29,8 +33,6 @@ import qualified System.Path as Path
 import qualified System.Path.Directory as Path
 import qualified Test.Tasty as Tasty
 import qualified Test.Tasty.HUnit as HUnit
-import qualified Language.Python.Grammar as TSP
-import qualified AST.Unmarshal as TS
 
 {-
 
@@ -56,7 +58,7 @@ The graph should be
 runScopeGraph :: ToScopeGraph t => Path.AbsRelFile -> Source.Source -> t Loc -> (ScopeGraph.ScopeGraph Name, Result)
 runScopeGraph p _src item = run . runSketch (Just p) $ scopeGraph item
 
-sampleGraphThing :: (Has Sketch sig m) => m Result
+sampleGraphThing :: (Has ScopeGraph sig m) => m Result
 sampleGraphThing = do
   declare "hello" (Props.Declaration ScopeGraph.Assignment ScopeGraph.Default Nothing (Span (Pos 2 0) (Pos 2 10)))
   declare "goodbye" (Props.Declaration ScopeGraph.Assignment ScopeGraph.Default Nothing (Span (Pos 3 0) (Pos 3 12)))
@@ -77,7 +79,7 @@ assertSimpleAssignment = do
   (expecto, Complete) <- runM $ runSketch Nothing sampleGraphThing
   HUnit.assertEqual "Should work for simple case" expecto result
 
-expectedReference :: (Has Sketch sig m) => m Result
+expectedReference :: (Has ScopeGraph sig m) => m Result
 expectedReference = do
   declare "x" (Props.Declaration ScopeGraph.Assignment ScopeGraph.Default Nothing (Span (Pos 0 0) (Pos 0 5)))
   reference "x" "x" Props.Reference
@@ -91,13 +93,13 @@ assertSimpleReference = do
 
   HUnit.assertEqual "Should work for simple case" expecto result
 
-expectedLexicalScope :: (Has Sketch sig m) => m Result
+expectedLexicalScope :: (Has ScopeGraph sig m) => m Result
 expectedLexicalScope = do
   _ <- declareFunction (Just $ Name.name "foo") (Props.Function ScopeGraph.Function (Span (Pos 0 0) (Pos 1 24)))
   reference "foo" "foo" Props.Reference {}
   pure Complete
 
-expectedFunctionArg :: (Has Sketch sig m) => m Result
+expectedFunctionArg :: (Has ScopeGraph sig m) => m Result
 expectedFunctionArg = do
   (_, associatedScope) <- declareFunction (Just $ Name.name "foo") (Props.Function ScopeGraph.Function (Span (Pos 0 0) (Pos 1 12)))
   withScope associatedScope $ do
@@ -107,6 +109,11 @@ expectedFunctionArg = do
   reference "foo" "foo" Props.Reference
   pure Complete
 
+expectedImportHole :: (Has ScopeGraph sig m) => m Result
+expectedImportHole = do
+  insertEdge ScopeGraph.Import (NonEmpty.fromList ["cheese", "ints"])
+  pure Complete
+
 assertLexicalScope :: HUnit.Assertion
 assertLexicalScope = do
   let path = "semantic-python/test/fixtures/5-02-simple-function.py"
@@ -123,6 +130,14 @@ assertFunctionArg = do
     (expecto, Complete) -> HUnit.assertEqual "Should work for simple case" expecto graph
     (_, Todo msg)       -> HUnit.assertFailure ("Failed to complete:" <>  show msg)
 
+assertImportHole :: HUnit.Assertion
+assertImportHole = do
+  let path = "semantic-python/test/fixtures/cheese/6-01-imports.py"
+  (graph, _) <- graphFile path
+  case run (runSketch Nothing expectedImportHole) of
+    (expecto, Complete) -> HUnit.assertEqual "Should work for simple case" expecto graph
+    (_, Todo msg)       -> HUnit.assertFailure ("Failed to complete:" <>  show msg)
+
 main :: IO ()
 main = do
   -- make sure we're in the root directory so the paths resolve properly
@@ -141,5 +156,8 @@ main = do
       Tasty.testGroup "lexical scopes" [
         HUnit.testCase "simple function scope" assertLexicalScope
       , HUnit.testCase "simple function argument" assertFunctionArg
+      ],
+      Tasty.testGroup "imports" [
+        HUnit.testCase "simple function argument" assertImportHole
       ]
     ]

semantic-python/test/fixtures/cheese/6-01-imports.py

@@ -0,0 +1 @@
+from cheese.ints import *

semantic-python/test/fixtures/cheese/ints.py

@@ -0,0 +1,5 @@
+def one():
+    return 1
+
+def two():
+    return 2

semantic-scope-graph/semantic-scope-graph.cabal

@@ -20,12 +20,18 @@ tested-with:         GHC == 8.6.5
 
 library
   exposed-modules:
-    Control.Carrier.Sketch.Fresh
+    Control.Carrier.Sketch.ScopeGraph
-    Control.Effect.Sketch
+    Control.Effect.ScopeGraph
-    ScopeGraph.Convert
+    Control.Effect.ScopeGraph.Properties.Declaration
-    ScopeGraph.Properties.Declaration
+    Control.Effect.ScopeGraph.Properties.Function
-    ScopeGraph.Properties.Function
+    Control.Effect.ScopeGraph.Properties.Reference
-    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

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,14 +25,15 @@ import           Control.Algebra
 import           Control.Carrier.Fresh.Strict
 import           Control.Carrier.Reader
 import           Control.Carrier.State.Strict
-import           Control.Effect.Sketch
+import           Control.Effect.ScopeGraph (ScopeGraphEff (..))
+import qualified Control.Effect.ScopeGraph.Properties.Declaration as Props
 import           Control.Monad.IO.Class
 import           Data.Bifunctor
+import qualified Data.List.NonEmpty as NonEmpty
 import           Data.Module
 import           Data.ScopeGraph (ScopeGraph)
 import qualified Data.ScopeGraph as ScopeGraph
 import           Data.Semilattice.Lower
-import qualified ScopeGraph.Properties.Declaration as Props
 import           Source.Span
 import qualified System.Path as Path
 
@@ -56,7 +57,7 @@ instance Lower Sketchbook where
 newtype SketchC address m a = SketchC (StateC Sketchbook (FreshC m) a)
   deriving (Applicative, Functor, Monad, MonadIO)
 
-instance (Effect sig, Algebra sig m) => Algebra (SketchEff :+: Reader Name :+: Fresh :+: sig) (SketchC Name m) where
+instance (Effect sig, Algebra sig m) => Algebra (ScopeGraphEff :+: Reader Name :+: Fresh :+: sig) (SketchC Name m) where
   alg (L (Declare n props k)) = do
     Sketchbook old current <- SketchC (get @Sketchbook)
     let Props.Declaration kind relation associatedScope span = props
@@ -92,6 +93,12 @@ instance (Effect sig, Algebra sig m) => Algebra (SketchEff :+: Reader Name :+: F
     let new = ScopeGraph.newScope name edges old
     SketchC (put (Sketchbook new current))
     k name
+  alg (L (InsertEdge label address k)) = do
+    Sketchbook old current <- SketchC get
+    let new = ScopeGraph.addImportEdge label (NonEmpty.toList address) current old
+    SketchC (put (Sketchbook new current))
+    k ()
+
   alg (R (L a)) = case a of
     Ask k -> SketchC (gets sCurrentScope) >>= k
     Local fn go k -> do

semantic-scope-graph/src/Control/Effect/ScopeGraph.hs

@@ -8,15 +8,16 @@
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeOperators #-}
 
--- | The Sketch effect is used to build up a scope graph over
+-- | The ScopeGraph effect is used to build up a scope graph over
 -- the lifetime of a monadic computation. The name is meant to evoke
 -- physically sketching the hierarchical outline of a graph.
-module Control.Effect.Sketch
+module Control.Effect.ScopeGraph
-  ( Sketch
+  ( ScopeGraph
-  , SketchEff (..)
+  , ScopeGraphEff (..)
   , declare
   -- Scope Manipulation
   , currentScope
+  , insertEdge
   , newScope
   , withScope
   , declareFunction
@@ -30,40 +31,47 @@ import qualified Analysis.Name as Name
 import           Control.Algebra
 import           Control.Effect.Fresh
 import           Control.Effect.Reader
+import           Data.List.NonEmpty
 import           Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Map
 import qualified Data.ScopeGraph as ScopeGraph
 import           Data.Text (Text)
 import           GHC.Generics (Generic, Generic1)
-import qualified ScopeGraph.Properties.Declaration as Props
-import qualified ScopeGraph.Properties.Function as Props
-import qualified ScopeGraph.Properties.Reference as Props
 
-type Sketch
+import qualified Control.Effect.ScopeGraph.Properties.Declaration as Props
-  = SketchEff
+import qualified Control.Effect.ScopeGraph.Properties.Function as Props
+import qualified Control.Effect.ScopeGraph.Properties.Reference as Props
+
+type ScopeGraph
+  = ScopeGraphEff
   :+: Fresh
   :+: Reader Name
 
-data SketchEff m k =
+data ScopeGraphEff m k =
     Declare Name Props.Declaration (() -> m k)
   | Reference Text Text Props.Reference (() -> m k)
   | NewScope (Map ScopeGraph.EdgeLabel [Name]) (Name -> m k)
+  | InsertEdge ScopeGraph.EdgeLabel (NonEmpty Name) (() -> m k)
   deriving (Generic, Generic1, HFunctor, Effect)
 
 currentScope :: Has (Reader Name) sig m => m Name
 currentScope = ask
 
-declare :: forall sig m . (Has Sketch sig m) => Name -> Props.Declaration -> m ()
+declare :: forall sig m . (Has ScopeGraph sig m) => Name -> Props.Declaration -> m ()
 declare n props = send (Declare n props pure)
 
 -- | Establish a reference to a prior declaration.
-reference :: forall sig m . (Has Sketch sig m) => Text -> Text -> Props.Reference -> m ()
+reference :: forall sig m . (Has ScopeGraph sig m) => Text -> Text -> Props.Reference -> m ()
 reference n decl props = send (Reference n decl props pure)
 
-newScope :: forall sig m . (Has Sketch sig m) => Map ScopeGraph.EdgeLabel [Name] -> m Name
+newScope :: forall sig m . Has ScopeGraph sig m => Map ScopeGraph.EdgeLabel [Name] -> m Name
 newScope edges = send (NewScope edges pure)
 
-declareFunction :: forall sig m . (Has Sketch sig m) => Maybe Name -> Props.Function -> m (Name, Name)
+-- | Takes an edge label and a list of names and inserts an import edge to a hole.
+insertEdge :: Has ScopeGraph sig m => ScopeGraph.EdgeLabel -> NonEmpty Name -> m ()
+insertEdge label targets = send (InsertEdge label targets pure)
+
+declareFunction :: forall sig m . (Has ScopeGraph sig m) => Maybe Name -> Props.Function -> m (Name, Name)
 declareFunction name (Props.Function kind span) = do
   currentScope' <- currentScope
   let lexicalEdges = Map.singleton ScopeGraph.Lexical [ currentScope' ]
@@ -76,7 +84,7 @@ declareFunction name (Props.Function kind span) = do
                                    }
   pure (name', associatedScope)
 
-declareMaybeName :: Has Sketch sig m
+declareMaybeName :: Has ScopeGraph sig m
                  => Maybe Name
                  -> Props.Declaration
                  -> m Name
@@ -87,9 +95,8 @@ declareMaybeName maybeName props = do
       name <- Name.gensym
       name <$ declare name (props { Props.relation = ScopeGraph.Gensym })
 
-withScope :: Has Sketch sig m
+withScope :: Has ScopeGraph sig m
           => Name
           -> m a
           -> m a
 withScope scope = local (const scope)
-

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
 

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
 

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
 

semantic-scope-graph/src/Data/ScopeGraph.hs

@@ -1,432 +1,13 @@
-{-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE DeriveFunctor #-}
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DuplicateRecordFields #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE TupleSections #-}
 module Data.ScopeGraph
-  ( Slot(..)
+  ( module Scope.Info
-  , Info(..)
+  , module Scope.Path
-  , associatedScope
+  , module Scope.Scope
-  , lookupDeclaration
+  , module Scope.Types
-  , declarationByName
+  , module Scope.Graph.AdjacencyList
-  , declarationsByAccessControl
-  , declarationsByRelation
-  , Declaration(..) -- TODO don't export these constructors
-  , declare
-  , formatDeclaration
-  , EdgeLabel(..)
-  , insertDeclarationScope
-  , insertDeclarationSpan
-  , insertImportReference
-  , newScope
-  , newPreludeScope
-  , insertScope
-  , insertEdge
-  , Path(..)
-  , pathDeclaration
-  , pathOfRef
-  , pathPosition
-  , Position(..)
-  , reference
-  , Reference(..) -- TODO don't export these constructors
-  , ReferenceInfo(..)
-  , Relation(..)
-  , ScopeGraph(..)
-  , Kind(..)
-  , lookupScope
-  , lookupScopePath
-  , Scope(..)
-  , scopeOfRef
-  , pathDeclarationScope
-  , putDeclarationScopeAtPosition
-  , declarationNames
-  , AccessControl(..)
   ) where
 
-import Prelude hiding (lookup)
+import Scope.Graph.AdjacencyList
-
+import Scope.Info
-import           Analysis.Name
+import Scope.Path
-import           Control.Applicative
+import Scope.Scope
-import           Control.Lens.Lens
+import Scope.Types
-import           Control.Monad
-import           Data.Aeson
-import           Data.Bifunctor
-import           Data.Foldable
-import           Data.Hashable
-import           Data.Hole
-import           Data.Map.Strict (Map)
-import qualified Data.Map.Strict as Map
-import           Data.Maybe
-import           Data.Module
-import           Data.Monoid
-import           Data.Semilattice.Lower
-import           Data.Sequence (Seq)
-import qualified Data.Sequence as Seq
-import           Data.Set (Set)
-import qualified Data.Set as Set
-import           Data.Text (Text)
-import           GHC.Generics
-import           Source.Span
-
--- A slot is a location in the heap where a value is stored.
-data Slot address = Slot { frameAddress :: address, position :: Position }
-    deriving (Eq, Show, Ord)
-
-
-data AccessControl = Public
-                   | Protected
-                   | Private
-                   deriving (Bounded, Enum, Eq, Generic, Hashable, ToJSON, Show)
-
--- | The Ord AccessControl instance represents an order specification of AccessControls.
--- AccessControls that are less than or equal to another AccessControl implies access.
--- It is helpful to consider `Public <= Private` as saying "Can a Public syntax term access a Private syntax term?"
--- In this way, Public AccessControl is the top of the order specification, and Private AccessControl is the bottom.
-instance Ord AccessControl where
-  -- | Private AccessControl represents the least overlap or accessibility with other AccessControls.
-  -- When asking if the AccessControl "on the left" is less than the AccessControl "on the right", Private AccessControl on the left always implies access to the thing on the right.
-  (<=) Private _           = True
-  (<=) _       Private     = False
-
-  -- | Protected AccessControl is in between Private and Public in the order specification.
-  -- Protected AccessControl "on the left" has access to Protected or Public AccessControls "on the right".
-  (<=) Protected Public    = True
-  (<=) Protected Protected = True
-
-  -- | Public AccessControl "on the left" has access only to Public AccessControl "on the right".
-  (<=) Public Public       = True
-  (<=) Public _            = False
-
-
-data Relation = Default | Instance | Prelude | Gensym
-  deriving (Bounded, Enum, Eq, Show, Ord)
-
-instance Lower Relation where
-  lowerBound = Default
-
-data Info scopeAddress = Info
-  { infoDeclaration     :: Declaration
-  , infoModule          :: ModuleInfo
-  , infoRelation        :: Relation
-  , infoAccessControl   :: AccessControl
-  , infoSpan            :: Span
-  , infoKind            :: Kind
-  , infoAssociatedScope :: Maybe scopeAddress
-  } deriving (Eq, Show, Ord)
-
-instance HasSpan (Info scopeAddress) where
-  span_ = lens infoSpan (\i s -> i { infoSpan = s })
-  {-# INLINE span_ #-}
-
-instance Lower (Info scopeAddress) where
-  lowerBound = Info lowerBound lowerBound lowerBound Public lowerBound lowerBound Nothing
-
-data ReferenceInfo = ReferenceInfo
-  { refSpan   :: Span
-  , refKind   :: Kind
-  , refModule :: ModuleInfo
-  } deriving (Eq, Show, Ord)
-
-instance HasSpan ReferenceInfo where
-  span_ = lens refSpan (\r s -> r { refSpan = s })
-  {-# INLINE span_ #-}
-
-data Kind = AbstractClass
-          | Assignment
-          | Call
-          | Class
-          | DefaultExport
-          | Function
-          | Identifier
-          | Let
-          | MemberAccess
-          | Method
-          | Module
-          | New
-          | Parameter
-          | PublicField
-          | QualifiedAliasedImport
-          | QualifiedExport
-          | QualifiedImport
-          | RequiredParameter
-          | This
-          | TypeAlias
-          | TypeIdentifier
-          | Unknown
-          | UnqualifiedImport
-          | VariableDeclaration
-  deriving (Bounded, Enum, Eq, Show, Ord)
-
-instance Lower Kind where
-  lowerBound = Unknown
-
-data Domain
-  = Standard
-  | Preluded
-  deriving (Eq, Show, Ord)
-
--- Offsets and frame addresses in the heap should be addresses?
-data Scope address = Scope
-  { edges        :: Map EdgeLabel [address]
-  , references   :: Map Reference ([ReferenceInfo], Path address)
-  , declarations :: Seq (Info address)
-  , domain       :: Domain
-  } deriving (Eq, Show, Ord)
-
-instance Lower (Scope scopeAddress) where
-  lowerBound = Scope mempty mempty mempty Standard
-
-instance AbstractHole (Scope scopeAddress) where
-  hole = lowerBound
-
-instance AbstractHole address => AbstractHole (Slot address) where
-  hole = Slot hole (Position 0)
-
-instance AbstractHole (Info address) where
-  hole = lowerBound
-
-newtype Position = Position { unPosition :: Int }
-  deriving (Eq, Show, Ord)
-
-newtype ScopeGraph scope = ScopeGraph { unScopeGraph :: Map scope (Scope scope) }
-  deriving (Eq, Ord, Show)
-
-instance Ord scope => Lower (ScopeGraph scope) where
-  lowerBound = ScopeGraph mempty
-
-data Path scope
-  = Hole
-  -- | Construct a direct path to a declaration.
-  | DPath Declaration Position
-  -- | Construct an edge from a scope to another declaration path.
-  | EPath EdgeLabel scope (Path scope)
-  deriving (Eq, Functor, Ord, Show)
-
-instance AbstractHole (Path scope) where
-  hole = Hole
-
--- Returns the declaration of a path.
-pathDeclaration :: Path scope -> Declaration
-pathDeclaration (DPath d _)   = d
-pathDeclaration (EPath _ _ p) = pathDeclaration p
-pathDeclaration Hole          = undefined
-
--- TODO: Store the current scope closer _in_ the DPath?
-pathDeclarationScope :: scope -> Path scope -> Maybe scope
-pathDeclarationScope _ (EPath _ scope (DPath _ _)) = Just scope
-pathDeclarationScope currentScope (EPath _ _ p)    = pathDeclarationScope currentScope p
-pathDeclarationScope currentScope (DPath _ _)      = Just currentScope
-pathDeclarationScope _ Hole                        = Nothing
-
--- TODO: Possibly return in Maybe since we can have Hole paths
-pathPosition :: Path scope -> Position
-pathPosition Hole          = Position 0
-pathPosition (DPath _ p)   = p
-pathPosition (EPath _ _ p) = pathPosition p
-
--- Returns the reference paths of a scope in a scope graph.
-pathsOfScope :: Ord scope => scope -> ScopeGraph scope -> Maybe (Map Reference ([ReferenceInfo], Path scope))
-pathsOfScope scope = fmap references . Map.lookup scope . unScopeGraph
-
--- Returns the declaration data of a scope in a scope graph.
-ddataOfScope :: Ord scope => scope -> ScopeGraph scope -> Maybe (Seq (Info scope))
-ddataOfScope scope = fmap declarations . Map.lookup scope . unScopeGraph
-
--- Returns the edges of a scope in a scope graph.
-linksOfScope :: Ord scope => scope -> ScopeGraph scope -> Maybe (Map EdgeLabel [scope])
-linksOfScope scope = fmap edges . Map.lookup scope . unScopeGraph
-
-declarationsByAccessControl :: Ord scope => scope -> AccessControl -> ScopeGraph scope -> [ Info scope ]
-declarationsByAccessControl scope accessControl g = fromMaybe mempty $ do
-  dataSeq <- ddataOfScope scope g
-  pure . toList $ Seq.filter (\Info{..} -> accessControl <= infoAccessControl) dataSeq
-
-declarationsByRelation :: Ord scope => scope -> Relation -> ScopeGraph scope -> [ Info scope ]
-declarationsByRelation scope relation g = fromMaybe mempty $ do
-  dataSeq <- ddataOfScope scope g
-  pure . toList $ Seq.filter (\Info{..} -> infoRelation == relation) dataSeq
-
-declarationByName :: Ord scope => scope -> Declaration -> ScopeGraph scope -> Maybe (Info scope)
-declarationByName scope name g = do
-  dataSeq <- ddataOfScope scope g
-  find (\Info{..} -> infoDeclaration == name) dataSeq
-
--- Lookup a scope in the scope graph.
-lookupScope :: Ord scope => scope -> ScopeGraph scope -> Maybe (Scope scope)
-lookupScope scope = Map.lookup scope . unScopeGraph
-
--- Declare a declaration with a span and an associated scope in the scope graph.
--- TODO: Return the whole value in Maybe or Either.
-declare :: Ord scope
-        => Declaration
-        -> ModuleInfo
-        -> Relation
-        -> AccessControl
-        -> Span
-        -> Kind
-        -> Maybe scope
-        -> scope
-        -> ScopeGraph scope
-        -> (ScopeGraph scope, Maybe Position)
-declare decl moduleInfo rel accessControl declSpan kind assocScope currentScope g = fromMaybe (g, Nothing) $ do
-  scope <- lookupScope currentScope g
-  dataSeq <- ddataOfScope currentScope g
-  case Seq.findIndexR (\Info{..} -> decl == infoDeclaration && declSpan == infoSpan && rel == infoRelation) dataSeq of
-    Just index -> pure (g, Just (Position index))
-    Nothing -> do
-      let newScope = scope { declarations = declarations scope Seq.|> Info decl moduleInfo rel accessControl declSpan kind assocScope }
-      pure (insertScope currentScope newScope g, Just (Position (length (declarations newScope))))
-
--- | Add a reference to a declaration in the scope graph.
--- Returns the original scope graph if the declaration could not be found.
-reference :: Ord scope => Reference -> ModuleInfo -> Span -> Kind -> Declaration -> scope -> ScopeGraph scope -> ScopeGraph scope
-reference ref moduleInfo span kind decl currentAddress g = fromMaybe g $ do
-  -- Start from the current address
-  currentScope' <- lookupScope currentAddress g
-  -- Build a path up to the declaration
-  flip (insertScope currentAddress) g . flip (insertReference ref moduleInfo span kind) currentScope' <$> findPath (const Nothing) decl currentAddress g
-
--- | Insert a reference into the given scope by constructing a resolution path to the declaration within the given scope graph.
-insertImportReference :: Ord address => Reference -> ModuleInfo -> Span -> Kind -> Declaration -> address -> ScopeGraph address -> Scope address -> Maybe (Scope address)
-insertImportReference ref moduleInfo span kind decl currentAddress g scope = flip (insertReference ref moduleInfo span kind) scope . EPath Import currentAddress <$> findPath (const Nothing) decl currentAddress g
-
-lookupScopePath :: Ord scopeAddress => Name -> scopeAddress -> ScopeGraph scopeAddress -> Maybe (Path scopeAddress)
-lookupScopePath declaration currentAddress g = findPath (flip (lookupReference declaration) g) (Declaration declaration) currentAddress g
-
-findPath :: Ord scopeAddress => (scopeAddress -> Maybe (Path scopeAddress)) -> Declaration -> scopeAddress -> ScopeGraph scopeAddress -> Maybe (Path scopeAddress)
-findPath extra decl currentAddress g = snd <$> getFirst (foldGraph combine currentAddress g)
-  where combine address path = fmap (address, )
-          $  First (pathToDeclaration decl address g)
-          <> First (extra address)
-          <> (uncurry (EPath Superclass) <$> path Superclass)
-          <> (uncurry (EPath Import)     <$> path Import)
-          <> (uncurry (EPath Export)     <$> path Export)
-          <> (uncurry (EPath Lexical)    <$> path Lexical)
-
-foldGraph :: (Ord scopeAddress, Monoid a) => (scopeAddress -> (EdgeLabel -> a) -> a) -> scopeAddress -> ScopeGraph scopeAddress -> a
-foldGraph combine address graph = go lowerBound address
-  where go visited address
-          | address `Set.notMember` visited
-          , Just edges <- linksOfScope address graph = combine address (recur edges)
-          | otherwise                                = mempty
-          where visited' = Set.insert address visited
-                recur edges edge = maybe mempty (foldMap (go visited')) (Map.lookup edge edges)
-
-pathToDeclaration :: Ord scopeAddress => Declaration -> scopeAddress -> ScopeGraph scopeAddress -> Maybe (Path scopeAddress)
-pathToDeclaration decl address g = DPath decl . snd <$> lookupDeclaration (unDeclaration decl) address g
-
-insertReference :: Reference -> ModuleInfo -> Span -> Kind -> Path scopeAddress -> Scope scopeAddress -> Scope scopeAddress
-insertReference ref moduleInfo span kind path scope = scope { references = Map.alter (\case
-  Nothing -> pure ([ ReferenceInfo span kind moduleInfo ], path)
-  Just (refInfos, path) -> pure (ReferenceInfo span kind moduleInfo : refInfos, path)) ref (references scope) }
-
-lookupDeclaration :: Ord scopeAddress => Name -> scopeAddress -> ScopeGraph scopeAddress -> Maybe (Info scopeAddress, Position)
-lookupDeclaration name scope g = do
-  dataSeq <- ddataOfScope scope g
-  index <- Seq.findIndexR (\Info{..} -> Declaration name == infoDeclaration) dataSeq
-  (, Position index) <$> Seq.lookup index dataSeq
-
-declarationNames :: Ord address => [EdgeLabel] -> Scope address -> ScopeGraph address -> Set Declaration
-declarationNames edgeLabels scope scopeGraph = localDeclarations <> edgeNames
-  where addresses = join (Map.elems $ Map.restrictKeys (edges scope) (Set.fromList edgeLabels))
-        edgeNames = flip foldMap addresses $ \address -> maybe mempty (flip (declarationNames edgeLabels) scopeGraph) (lookupScope address scopeGraph)
-        localDeclarations = Set.fromList . toList . fmap infoDeclaration $ declarations scope
-
-
-putDeclarationScopeAtPosition :: Ord scopeAddress => scopeAddress -> Position -> Maybe scopeAddress -> ScopeGraph scopeAddress -> ScopeGraph scopeAddress
-putDeclarationScopeAtPosition scope position assocScope g@(ScopeGraph graph) = fromMaybe g $ do
-  dataSeq <- ddataOfScope scope g
-  let seq = Seq.adjust' (\Info{..} -> Info { infoAssociatedScope = assocScope, .. }) (unPosition position) dataSeq
-  pure $ ScopeGraph (Map.adjust (\s -> s { declarations = seq }) scope graph)
-
-lookupReference :: Ord scopeAddress => Name -> scopeAddress -> ScopeGraph scopeAddress -> Maybe (Path scopeAddress)
-lookupReference  name scope g = fmap snd . Map.lookup (Reference name) =<< pathsOfScope scope g
-
-insertEdge :: Ord scopeAddress => EdgeLabel -> scopeAddress -> scopeAddress -> ScopeGraph scopeAddress -> ScopeGraph scopeAddress
-insertEdge label target currentAddress g@(ScopeGraph graph) = fromMaybe g $ do
-  currentScope' <- lookupScope currentAddress g
-  scopes <- maybe (Just mempty) pure (Map.lookup label (edges currentScope'))
-  let newScope = currentScope' { edges = Map.insert label (target : scopes) (edges currentScope') }
-  pure (ScopeGraph (Map.insert currentAddress newScope graph))
-
-
--- | Update the 'Scope' containing a 'Declaration' with an associated scope address.
--- Returns an unmodified 'ScopeGraph' if the 'Declaration' cannot be found with the given scope address.
-insertDeclarationScope :: Ord scopeAddress => Declaration -> scopeAddress -> scopeAddress -> ScopeGraph scopeAddress -> ScopeGraph scopeAddress
-insertDeclarationScope Declaration{..} associatedScopeAddress scopeAddress g = fromMaybe g $ do
-  declScopeAddress <- pathDeclarationScope scopeAddress =<< lookupScopePath unDeclaration scopeAddress g
-  scope <- lookupScope declScopeAddress g
-  (declInfo, position) <- second unPosition <$> lookupDeclaration unDeclaration declScopeAddress g
-  pure $ insertScope declScopeAddress (scope { declarations = Seq.update position (declInfo { infoAssociatedScope = Just associatedScopeAddress }) (declarations scope) }) g
-
--- | Insert a declaration span into the declaration in the scope graph.
-insertDeclarationSpan :: Ord scopeAddress => Declaration -> Span -> ScopeGraph scopeAddress -> ScopeGraph scopeAddress
-insertDeclarationSpan decl@Declaration{..} span g = fromMaybe g $ do
-  declScopeAddress <- scopeOfDeclaration decl g
-  (declInfo, position) <- second unPosition <$> lookupDeclaration unDeclaration declScopeAddress g
-  scope <- lookupScope declScopeAddress g
-  pure $ insertScope declScopeAddress (scope { declarations = Seq.update position (declInfo { infoSpan = span }) (declarations scope) }) g
-
--- | Insert a new scope with the given address and edges into the scope graph.
-newScope :: Ord address => address -> Map EdgeLabel [address] -> ScopeGraph address -> ScopeGraph address
-newScope address edges = insertScope address (Scope edges mempty mempty Standard)
-
--- | Insert a new scope with the given address and edges into the scope graph.
-newPreludeScope :: Ord address => address -> Map EdgeLabel [address] -> ScopeGraph address -> ScopeGraph address
-newPreludeScope address edges = insertScope address (Scope edges mempty mempty Preluded)
-
-insertScope :: Ord address => address -> Scope address -> ScopeGraph address -> ScopeGraph address
-insertScope address scope = ScopeGraph . Map.insert address scope . unScopeGraph
-
--- | Returns the scope of a reference in the scope graph.
-scopeOfRef :: Ord scope => Reference -> ScopeGraph scope -> Maybe scope
-scopeOfRef ref g@(ScopeGraph graph) = go (Map.keys graph)
-  where
-    go (s : scopes') = fromMaybe (go scopes') $ do
-      pathMap <- pathsOfScope s g
-      _ <- Map.lookup ref pathMap
-      pure (Just s)
-    go [] = Nothing
-
--- | Returns the path of a reference in the scope graph.
-pathOfRef :: (Ord scope) => Reference -> ScopeGraph scope -> Maybe (Path scope)
-pathOfRef ref graph = do
-  scope <- scopeOfRef ref graph
-  pathsMap <- pathsOfScope scope graph
-  snd <$> Map.lookup ref pathsMap
-
--- Returns the scope the declaration was declared in.
-scopeOfDeclaration :: Ord scope => Declaration -> ScopeGraph scope -> Maybe scope
-scopeOfDeclaration Declaration{..} g@(ScopeGraph graph) = go (Map.keys graph)
-  where
-    go = foldr (\ scope -> (scope <$ lookupDeclaration unDeclaration scope g <|>)) Nothing
-
--- | Returns the scope associated with a declaration (the child scope if any exists).
-associatedScope :: Ord scope => Declaration -> ScopeGraph scope -> Maybe scope
-associatedScope Declaration{..} g@(ScopeGraph graph) = go (Map.keys graph)
-  where
-    go = foldr lookupAssociatedScope Nothing
-    lookupAssociatedScope scope = ((lookupDeclaration unDeclaration scope g >>= infoAssociatedScope . fst) <|>)
-
-newtype Reference = Reference { unReference :: Name }
-  deriving (Eq, Ord, Show)
-
-instance Lower Reference where
-  lowerBound = Reference $ name ""
-
-newtype Declaration = Declaration { unDeclaration :: Name }
-  deriving (Eq, Ord, Show)
-
-instance Lower Declaration where
-  lowerBound = Declaration $ name ""
-
-formatDeclaration :: Declaration -> Text
-formatDeclaration = formatName . unDeclaration
-
--- | The type of edge from a scope to its parent scopes.
--- Either a lexical edge or an import edge in the case of non-lexical edges.
-data EdgeLabel = Lexical | Import | Export | Superclass
-  deriving (Bounded, Enum, Eq, Ord, Show)

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) <|>)

semantic-scope-graph/src/Scope/Graph/Convert.hs

@@ -6,21 +6,21 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeOperators #-}
-module ScopeGraph.Convert
+module Scope.Graph.Convert
   ( ToScopeGraph (..)
   , Result (..)
   , todo
   , complete
   ) where
 
-import Control.Effect.Sketch
+import Control.Effect.ScopeGraph
 import Data.List.NonEmpty
 import Data.Typeable
 import Source.Loc
 
 class Typeable t => ToScopeGraph t where
   scopeGraph ::
-    ( Has Sketch sig m
+    ( Has ScopeGraph sig m
     )
     => t Loc
     -> m Result

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
+
+

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

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 ""

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

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

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

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