Make declare actually do something… in theory.

semantic-python/app/Main.hs

@@ -11,6 +11,7 @@ import           Control.Carrier.Sketch.Fresh
 import           Control.Monad
 import           Convert.ToScopeGraph
 import qualified Data.ByteString as ByteString
+import           Data.Name (Name)
 import qualified Data.ScopeGraph as ScopeGraph
 import qualified Language.Python ()
 import           Source.Loc
@@ -42,13 +43,13 @@ The graph should be
 -}
 
 
-runScopeGraph :: ToScopeGraph t => Path.AbsRelFile -> Source.Source -> t Loc -> (ScopeGraph.ScopeGraph Addr, Result)
+runScopeGraph :: ToScopeGraph t => Path.AbsRelFile -> Source.Source -> t Loc -> (ScopeGraph.ScopeGraph Name, Result)
-runScopeGraph p _src item = run . runSketch @Addr (Just p) $ scopeGraph item
+runScopeGraph p _src item = run . runSketch @Name (Just p) $ scopeGraph item
 
-sampleGraphThing :: (Has (Sketch Addr) sig m) => m Result
+sampleGraphThing :: (Has (Sketch Name) sig m) => m Result
 sampleGraphThing = do
-  declare @Addr "hello" DeclProperties
+  declare @Name "hello" DeclProperties
-  declare @Addr "goodbye" DeclProperties
+  declare @Name "goodbye" DeclProperties
   pure Complete
 
 
@@ -61,7 +62,7 @@ main = do
   file <- ByteString.readFile path
   tree <- TS.parseByteString @Py.Module @Loc TSP.tree_sitter_python file
   pyModule <- either die pure tree
-  let (expecto, Complete) = run $ runSketch @Addr Nothing sampleGraphThing
+  let (expecto, Complete) = run $ runSketch @Name Nothing sampleGraphThing
   let (result, Complete) = runScopeGraph (Path.absRel path) (Source.fromUTF8 file) pyModule
   print result
   assertEqual expecto result

semantic-python/src/Language/Python.hs

@@ -21,6 +21,7 @@ import           Control.Effect.Sketch
 import           Convert.ToScopeGraph
 import           Data.Foldable
 import qualified Data.List.NonEmpty as NonEmpty
+import           Data.Name (Name)
 import           Language.Python.Core (pattern SingleIdentifier)
 import qualified Language.Python.Tags as PyTags
 import qualified Tags.Tagging.Precise as Tags
@@ -48,7 +49,7 @@ instance ToScopeGraph Term where
 instance ToScopeGraph Py.AssertStatement where scopeGraph = onChildren
 
 instance ToScopeGraph Py.Assignment where
-  scopeGraph (Py.Assignment _ (SingleIdentifier t) _val _typ) = complete <* declare @Addr t DeclProperties
+  scopeGraph (Py.Assignment _ (SingleIdentifier t) _val _typ) = complete <* declare @Name t DeclProperties
   scopeGraph x                                                = todo x
 
 instance ToScopeGraph Py.Await where

semantic-scope-graph/src/Control/Carrier/Sketch/Fresh.hs

@@ -9,6 +9,7 @@
 {-# LANGUAGE TypeApplications           #-}
 {-# LANGUAGE TypeOperators              #-}
 {-# LANGUAGE UndecidableInstances       #-}
+{-# LANGUAGE TypeFamilies #-}
 {-# OPTIONS_GHC -Wno-redundant-constraints #-}
 
 module Control.Carrier.Sketch.Fresh
@@ -22,11 +23,15 @@ import           Control.Carrier.Fresh.Strict
 import           Control.Carrier.State.Strict
 import           Control.Effect.Sketch
 import           Control.Monad.IO.Class
+import           Data.Module
+import           Data.Name (Name)
+import qualified Data.Name
 import           Data.Bifunctor
 import           Data.ScopeGraph (ScopeGraph)
 import qualified Data.ScopeGraph as ScopeGraph
 import           Data.Semilattice.Lower
 import qualified System.Path as Path
+import Source.Span
 
 newtype Sketchbook address = Sketchbook
   { sGraph  :: ScopeGraph address
@@ -35,8 +40,22 @@ newtype Sketchbook address = Sketchbook
 newtype SketchC address m a = SketchC (StateC (Sketchbook address) (FreshC m) a)
   deriving (Applicative, Functor, Monad, MonadIO)
 
-instance forall address sig m . (Effect sig, Algebra sig m) => Algebra (Sketch address :+: sig) (SketchC address m) where
+instance forall address sig m . (address ~ Name, Effect sig, Algebra sig m) => Algebra (Sketch Name :+: sig) (SketchC Name m) where
-  alg (L (Declare _name _props k)) = do
+  alg (L (Declare n _props k)) = do
+    old <- SketchC (gets @(Sketchbook address) sGraph)
+    addr <- SketchC Data.Name.gensym
+    let (new, _pos) =
+          ScopeGraph.declare
+          (ScopeGraph.Declaration (Data.Name.name n))
+          (lowerBound @ModuleInfo)
+          ScopeGraph.Default
+          ScopeGraph.Public
+          (lowerBound @Span)
+          ScopeGraph.Identifier
+          Nothing
+          addr
+          old
+    SketchC (put (Sketchbook new))
     k ()
   alg (R other) = SketchC (alg (R (R (handleCoercible other))))
 

semantic-scope-graph/src/Convert/ToScopeGraph.hs

@@ -7,7 +7,6 @@
 {-# LANGUAGE TypeOperators             #-}
 module Convert.ToScopeGraph
   ( ToScopeGraph (..)
-  , Addr
   , Result (..)
   , onChildren
   , onField
@@ -15,15 +14,15 @@ module Convert.ToScopeGraph
 
 import Control.Effect.Sketch
 import Data.Foldable
+import Data.Name (Name)
+import Data.Typeable
 import GHC.Generics
 import GHC.Records
 import Source.Loc
 
-type Addr = Int
+class Typeable t => ToScopeGraph t where
-
-class ToScopeGraph t where
   scopeGraph ::
-    ( Has (Sketch Addr) sig m
+    ( Has (Sketch Name) sig m
     )
     => t Loc
     -> m Result
@@ -44,7 +43,7 @@ instance (ToScopeGraph l, ToScopeGraph r) => ToScopeGraph (l :+: r) where
 
 onField ::
   forall field syn sig m r .
-  ( Has (Sketch Addr) sig m
+  ( Has (Sketch Name) sig m
   , HasField field (r Loc) (syn Loc)
   , ToScopeGraph syn
   )
@@ -57,7 +56,7 @@ onField
 onChildren ::
   ( Traversable t
   , ToScopeGraph syn
-  , Has (Sketch Addr) sig m
+  , Has (Sketch Name) sig m
   , HasField "extraChildren" (r Loc) (t (syn Loc))
   )
   => r Loc