From f927f0b8c0f12bc077af50b448235076d4d027b6 Mon Sep 17 00:00:00 2001 From: joshvera Date: Wed, 5 Feb 2020 19:46:58 -0500 Subject: [PATCH] Rename Sketch effect to a ScopeGraph effect --- .../src/Language/Python/ScopeGraph.hs | 10 +++--- semantic-python/test-graphing/GraphTest.hs | 10 +++--- .../semantic-scope-graph.cabal | 4 +-- .../Sketch/{Fresh.hs => ScopeGraph.hs} | 8 ++--- .../Effect/{Sketch.hs => ScopeGraph.hs} | 31 ++++++++++--------- 5 files changed, 32 insertions(+), 31 deletions(-) rename semantic-scope-graph/src/Control/Carrier/Sketch/{Fresh.hs => ScopeGraph.hs} (92%) rename semantic-scope-graph/src/Control/Effect/{Sketch.hs => ScopeGraph.hs} (76%) diff --git a/semantic-python/src/Language/Python/ScopeGraph.hs b/semantic-python/src/Language/Python/ScopeGraph.hs index ab99cb2fe..e997b530a 100644 --- a/semantic-python/src/Language/Python/ScopeGraph.hs +++ b/semantic-python/src/Language/Python/ScopeGraph.hs @@ -26,7 +26,7 @@ import AST.Element import qualified Analysis.Name as Name import Control.Algebra (Algebra (..), handleCoercible) import Control.Effect.Fresh -import Control.Effect.Sketch +import Control.Effect.ScopeGraph import Data.Foldable import Data.Maybe import Data.Monoid @@ -49,7 +49,7 @@ instance Algebra sig m => Algebra sig (Ap m) where -- every single Python AST type. class (forall a . Show a => Show (t a)) => ToScopeGraph t where scopeGraph :: - ( Has Sketch sig m + ( Has ScopeGraph sig m , Monoid (m Result) ) => t Loc @@ -61,7 +61,7 @@ instance (ToScopeGraph l, ToScopeGraph r) => ToScopeGraph (l :+: r) where onField :: forall (field :: Symbol) syn sig m r . - ( Has Sketch sig m + ( Has ScopeGraph sig m , HasField field (r Loc) (syn Loc) , ToScopeGraph syn , Monoid (m Result) @@ -75,7 +75,7 @@ onField onChildren :: ( Traversable t , ToScopeGraph syn - , Has Sketch sig m + , Has ScopeGraph sig m , HasField "extraChildren" (r Loc) (t (syn Loc)) , Monoid (m Result) ) @@ -86,7 +86,7 @@ onChildren . traverse scopeGraph . getField @"extraChildren" -scopeGraphModule :: Has Sketch sig m => Py.Module Loc -> m Result +scopeGraphModule :: Has ScopeGraph sig m => Py.Module Loc -> m Result scopeGraphModule = getAp . scopeGraph instance ToScopeGraph Py.AssertStatement where scopeGraph = onChildren diff --git a/semantic-python/test-graphing/GraphTest.hs b/semantic-python/test-graphing/GraphTest.hs index e915438fc..918d4a46e 100644 --- a/semantic-python/test-graphing/GraphTest.hs +++ b/semantic-python/test-graphing/GraphTest.hs @@ -51,7 +51,7 @@ The graph should be runScopeGraph :: ToScopeGraph t => Path.AbsRelFile -> Source.Source -> t Loc -> (ScopeGraph.ScopeGraph Name, Result) runScopeGraph p _src item = run . runSketch (Just p) $ scopeGraph item -sampleGraphThing :: (Has Sketch sig m) => m Result +sampleGraphThing :: (Has ScopeGraph sig m) => m Result sampleGraphThing = do declare "hello" (DeclProperties ScopeGraph.Assignment ScopeGraph.Default Nothing) declare "goodbye" (DeclProperties ScopeGraph.Assignment ScopeGraph.Default Nothing) @@ -72,7 +72,7 @@ assertSimpleAssignment = do (expecto, Complete) <- runM $ runSketch Nothing sampleGraphThing HUnit.assertEqual "Should work for simple case" expecto result -expectedReference :: (Has Sketch sig m) => m Result +expectedReference :: (Has ScopeGraph sig m) => m Result expectedReference = do declare "x" (DeclProperties ScopeGraph.Assignment ScopeGraph.Default Nothing) reference "x" "x" RefProperties @@ -86,13 +86,13 @@ assertSimpleReference = do HUnit.assertEqual "Should work for simple case" expecto result -expectedLexicalScope :: (Has Sketch sig m) => m Result +expectedLexicalScope :: (Has ScopeGraph sig m) => m Result expectedLexicalScope = do _ <- declareFunction (Just $ Name.name "foo") (FunProperties ScopeGraph.Function) reference "foo" "foo" RefProperties {} pure Complete -expectedFunctionArg :: (Has Sketch sig m) => m Result +expectedFunctionArg :: (Has ScopeGraph sig m) => m Result expectedFunctionArg = do (_, associatedScope) <- declareFunction (Just $ Name.name "foo") (FunProperties ScopeGraph.Function) withScope associatedScope $ do @@ -102,7 +102,7 @@ expectedFunctionArg = do reference "foo" "foo" RefProperties pure Complete -expectedImportHole :: (Has Sketch sig m) => m Result +expectedImportHole :: (Has ScopeGraph sig m) => m Result expectedImportHole = do addImportEdge Import ["cheese", "ints"] diff --git a/semantic-scope-graph/semantic-scope-graph.cabal b/semantic-scope-graph/semantic-scope-graph.cabal index cf8f65f14..f7898fe8a 100644 --- a/semantic-scope-graph/semantic-scope-graph.cabal +++ b/semantic-scope-graph/semantic-scope-graph.cabal @@ -20,8 +20,8 @@ tested-with: GHC == 8.6.5 library exposed-modules: - Control.Carrier.Sketch.Fresh - Control.Effect.Sketch + Control.Carrier.Sketch.ScopeGraph + Control.Effect.ScopeGraph ScopeGraph.Convert Data.Hole Data.Module diff --git a/semantic-scope-graph/src/Control/Carrier/Sketch/Fresh.hs b/semantic-scope-graph/src/Control/Carrier/Sketch/ScopeGraph.hs similarity index 92% rename from semantic-scope-graph/src/Control/Carrier/Sketch/Fresh.hs rename to semantic-scope-graph/src/Control/Carrier/Sketch/ScopeGraph.hs index 8aad15695..99b21ba14 100644 --- a/semantic-scope-graph/src/Control/Carrier/Sketch/Fresh.hs +++ b/semantic-scope-graph/src/Control/Carrier/Sketch/ScopeGraph.hs @@ -13,10 +13,10 @@ -- | This carrier interprets the Sketch effect, keeping track of -- the current scope and in-progress graph internally. -module Control.Carrier.Sketch.Fresh +module Control.Carrier.Sketch.ScopeGraph ( SketchC (..) , runSketch - , module Control.Effect.Sketch + , module Control.Effect.ScopeGraph ) where import Analysis.Name (Name) @@ -25,7 +25,7 @@ import Control.Algebra import Control.Carrier.Fresh.Strict import Control.Carrier.State.Strict import Control.Carrier.Reader -import Control.Effect.Sketch +import Control.Effect.ScopeGraph (ScopeGraphEff(..), DeclProperties(..)) import Control.Monad.IO.Class import Data.Bifunctor import Data.Module @@ -56,7 +56,7 @@ instance Lower Sketchbook where newtype SketchC address m a = SketchC (StateC Sketchbook (FreshC m) a) deriving (Applicative, Functor, Monad, MonadIO) -instance (Effect sig, Algebra sig m) => Algebra (SketchEff :+: Reader Name :+: Fresh :+: sig) (SketchC Name m) where +instance (Effect sig, Algebra sig m) => Algebra (ScopeGraphEff :+: Reader Name :+: Fresh :+: sig) (SketchC Name m) where alg (L (Declare n props k)) = do Sketchbook old current <- SketchC (get @Sketchbook) let (new, _pos) = diff --git a/semantic-scope-graph/src/Control/Effect/Sketch.hs b/semantic-scope-graph/src/Control/Effect/ScopeGraph.hs similarity index 76% rename from semantic-scope-graph/src/Control/Effect/Sketch.hs rename to semantic-scope-graph/src/Control/Effect/ScopeGraph.hs index 2a4e0d2b8..ae9779c64 100644 --- a/semantic-scope-graph/src/Control/Effect/Sketch.hs +++ b/semantic-scope-graph/src/Control/Effect/ScopeGraph.hs @@ -8,12 +8,12 @@ {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeOperators #-} --- | The Sketch effect is used to build up a scope graph over +-- | The ScopeGraph effect is used to build up a scope graph over -- the lifetime of a monadic computation. The name is meant to evoke --- physically sketching the hierarchical outline of a graph. -module Control.Effect.Sketch - ( Sketch - , SketchEff (..) +-- physically ScopeGraphing the hierarchical outline of a graph. +module Control.Effect.ScopeGraph + ( ScopeGraph + , ScopeGraphEff (..) , DeclProperties (..) , RefProperties (..) , FunProperties (..) @@ -53,12 +53,12 @@ data FunProperties = FunProperties { kind :: ScopeGraph.Kind } -type Sketch - = SketchEff +type ScopeGraph + = ScopeGraphEff :+: Fresh :+: Reader Name -data SketchEff m k = +data ScopeGraphEff m k = Declare Name DeclProperties (() -> m k) | Reference Text Text RefProperties (() -> m k) | NewScope (Map ScopeGraph.EdgeLabel [Name]) (Name -> m k) @@ -68,20 +68,21 @@ data SketchEff m k = currentScope :: Has (Reader Name) sig m => m Name currentScope = ask -declare :: forall sig m . (Has Sketch sig m) => Name -> DeclProperties -> m () +declare :: forall sig m . Has ScopeGraph sig m => Name -> DeclProperties -> m () declare n props = send (Declare n props pure) -- | Establish a reference to a prior declaration. -reference :: forall sig m . (Has Sketch sig m) => Text -> Text -> RefProperties -> m () +reference :: forall sig m . Has ScopeGraph sig m => Text -> Text -> RefProperties -> m () reference n decl props = send (Reference n decl props pure) -newScope :: forall sig m . (Has Sketch sig m) => Map ScopeGraph.EdgeLabel [Name] -> m Name +newScope :: forall sig m . Has ScopeGraph sig m => Map ScopeGraph.EdgeLabel [Name] -> m Name newScope edges = send (NewScope edges pure) -insertEdge :: Has Sketch sig m => ScopeGraph.EdgeLabel -> NonEmpty Name -> m () +-- | Takes an edge label and a list of names and inserts an import edge to a hole. +insertEdge :: Has ScopeGraph sig m => ScopeGraph.EdgeLabel -> NonEmpty Name -> m () insertEdge label targets = send (InsertEdge label targets pure) -declareFunction :: forall sig m . (Has Sketch sig m) => Maybe Name -> FunProperties -> m (Name, Name) +declareFunction :: forall sig m . Has ScopeGraph sig m => Maybe Name -> FunProperties -> m (Name, Name) declareFunction name props = do currentScope' <- currentScope let lexicalEdges = Map.singleton ScopeGraph.Lexical [ currentScope' ] @@ -89,7 +90,7 @@ declareFunction name props = do name' <- declareMaybeName name (DeclProperties { relation = ScopeGraph.Default, kind = (getField @"kind" @FunProperties props), associatedScope = Just associatedScope }) pure (name', associatedScope) -declareMaybeName :: Has Sketch sig m +declareMaybeName :: Has ScopeGraph sig m => Maybe Name -> DeclProperties -> m Name @@ -98,7 +99,7 @@ declareMaybeName maybeName props = do Just name -> declare name props >> pure name _ -> Name.gensym >>= \name -> declare name (props { relation = ScopeGraph.Gensym }) >> pure name -- TODO: Modify props and change Kind to Gensym -withScope :: Has Sketch sig m +withScope :: Has ScopeGraph sig m => Name -> m a -> m a