Merge remote-tracking branch 'origin/master' into function-scopes

semantic-analysis/semantic-analysis.cabal

@@ -50,6 +50,7 @@ library
     Analysis.Effect.Heap
     Analysis.File
     Analysis.FlowInsensitive
+    Analysis.Functor.Named
     Analysis.ImportGraph
     Analysis.Intro
     Analysis.Name
@@ -66,6 +67,7 @@ library
     , fused-syntax
     , hashable
     , haskeline                   ^>= 0.7.5
+    , hashable
     , lingo                       ^>= 0.3
     , pathtype                    ^>= 0.8.1
     , prettyprinter                >= 1.2 && < 2

semantic-analysis/src/Analysis/Concrete.hs

@@ -29,7 +29,7 @@ import qualified Analysis.Carrier.Env.Precise as A
 import qualified Analysis.Carrier.Heap.Precise as A
 import qualified Analysis.Effect.Domain as A
 import           Analysis.File
-import           Analysis.Name
+import           Analysis.Functor.Named
 import           Control.Algebra
 import           Control.Carrier.Fail.WithLoc
 import           Control.Carrier.Fresh.Strict
@@ -178,7 +178,7 @@ heapAddressGraph = heapGraph (\ addr v -> (Value v, addr)) (fmap G.vertex . (,)
 addressStyle :: Heap (Concrete term) -> G.Style (EdgeType (Concrete term), Addr) Text
 addressStyle heap = (G.defaultStyle vertex) { G.edgeAttributes }
   where vertex (_, addr) = pack (show addr) <> " = " <> maybe "?" fromConcrete (IntMap.lookup addr heap)
-        edgeAttributes _ (Slot name,    _) = ["label" G.:= unName name]
+        edgeAttributes _ (Slot name,    _) = ["label" G.:= formatName name]
         edgeAttributes _ (Edge Import,  _) = ["color" G.:= "blue"]
         edgeAttributes _ (Edge Lexical, _) = ["color" G.:= "green"]
         edgeAttributes _ _                 = []
@@ -186,7 +186,7 @@ addressStyle heap = (G.defaultStyle vertex) { G.edgeAttributes }
           Unit ->  "()"
           Bool b -> pack $ show b
           String s -> pack $ show s
-          Closure p (Span s e) (Named n _) -> "\\\\ " <> unName n <> " [" <> pack (Path.toString p) <> ":" <> showPos s <> "-" <> showPos e <> "]"
+          Closure p (Span s e) (Named n _) -> "\\\\ " <> formatName n <> " [" <> pack (Path.toString p) <> ":" <> showPos s <> "-" <> showPos e <> "]"
           Record _ -> "{}"
         showPos (Pos l c) = pack (show l) <> ":" <> pack (show c)
 

semantic-analysis/src/Analysis/Effect/Domain.hs

@@ -24,7 +24,7 @@ module Analysis.Effect.Domain
 , run
 ) where
 
-import Analysis.Name
+import Analysis.Functor.Named
 import Control.Algebra
 import Data.Text (Text)
 import GHC.Generics (Generic1)

semantic-analysis/src/Analysis/Functor/Named.hs

@@ -0,0 +1,37 @@
+{-# LANGUAGE DeriveFoldable #-}
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE DeriveTraversable #-}
+module Analysis.Functor.Named
+( module Analysis.Name
+, Named (..)
+, named
+, named'
+, namedName
+, namedValue
+) where
+
+
+import Analysis.Name
+import Data.Function (on)
+
+-- | Annotates an @a@ with a 'Name'-provided name, which is ignored for '==' and 'compare'.
+data Named a = Named Name a
+  deriving (Foldable, Functor, Show, Traversable)
+
+named :: Name -> a -> Named a
+named = Named
+
+named' :: Name -> Named Name
+named' u = Named u u
+
+namedName :: Named a -> Name
+namedName (Named n _) = n
+
+namedValue :: Named a -> a
+namedValue (Named _ a) = a
+
+instance Eq a => Eq (Named a) where
+  (==) = (==) `on` namedValue
+
+instance Ord a => Ord (Named a) where
+  compare = compare `on` namedValue

semantic-analysis/src/Analysis/ImportGraph.hs

@@ -21,7 +21,7 @@ import qualified Analysis.Carrier.Heap.Monovariant as A
 import qualified Analysis.Effect.Domain as A
 import           Analysis.File
 import           Analysis.FlowInsensitive
-import           Analysis.Name
+import           Analysis.Functor.Named
 import           Control.Algebra
 import           Control.Applicative (Alternative (..))
 import           Control.Carrier.Fail.WithLoc

semantic-analysis/src/Analysis/Intro.hs

@@ -11,7 +11,7 @@ module Analysis.Intro
 , record
 ) where
 
-import Analysis.Name
+import Analysis.Functor.Named
 import Control.Algebra
 import Data.Text (Text)
 import GHC.Generics (Generic1)

semantic-analysis/src/Analysis/Name.hs

@@ -1,40 +1,68 @@
-{-# LANGUAGE DeriveTraversable, GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE OverloadedStrings #-}
 module Analysis.Name
-( Name(..)
-, Named(..)
-, named
-, named'
-, namedName
-, namedValue
+( Name
+-- * Constructors
+, gensym
+, name
+, nameI
+, formatName
+, isGenerated
 ) where
 
-import Data.Function (on)
-import Data.String (IsString)
-import Data.Text (Text)
+import           Control.Effect.Fresh
+import           Data.Aeson
+import qualified Data.Char as Char
+import           Data.Hashable
+import           Data.String
+import           Data.Text (Text)
+import qualified Data.Text as Text
 
--- | User-specified and -relevant names.
-newtype Name = Name { unName :: Text }
-  deriving (Eq, IsString, Ord, Show)
+-- | The type of variable names.
+data Name
+  = Name Text
+  | I Int
+  deriving (Eq, Ord)
 
+instance IsString Name where
+  fromString = Name . fromString
 
--- | Annotates an @a@ with a 'Name'-provided name, which is ignored for '==' and 'compare'.
-data Named a = Named Name a
-  deriving (Foldable, Functor, Show, Traversable)
+-- | Generate a fresh (unused) name for use in synthesized variables/closures/etc.
+gensym :: Has Fresh sig m => m Name
+gensym = I <$> fresh
 
-named :: Name -> a -> Named a
-named = Named
+-- | Construct a 'Name' from a 'Text'.
+name :: Text -> Name
+name = Name
 
-named' :: Name -> Named Name
-named' u = Named u u
+isGenerated :: Name -> Bool
+isGenerated (I _) = True
+isGenerated _     = False
 
-namedName :: Named a -> Name
-namedName (Named n _) = n
+-- | Construct a 'Name' from an 'Int'. This is suitable for automatic generation, e.g. using a Fresh effect, but should not be used for human-generated names.
+nameI :: Int -> Name
+nameI = I
 
-namedValue :: Named a -> a
-namedValue (Named _ a) = a
+-- | Extract a human-readable 'Text' from a 'Name'.
+-- Sample outputs can be found in @Data.Abstract.Name.Spec@.
+formatName :: Name -> Text
+formatName (Name name) = name
+formatName (I i)       = Text.pack $ '_' : (alphabet !! a) : replicate n 'ʹ'
+  where alphabet = ['a'..'z']
+        (n, a) = i `divMod` length alphabet
 
-instance Eq a => Eq (Named a) where
-  (==) = (==) `on` namedValue
+instance Show Name where
+  showsPrec _ = prettyShowString . Text.unpack . formatName
+    where prettyShowString str = showChar '"' . foldr ((.) . prettyChar) id str . showChar '"'
+          prettyChar c
+            | c `elem` ['\\', '\"'] = Char.showLitChar c
+            | Char.isPrint c        = showChar c
+            | otherwise             = Char.showLitChar c
 
-instance Ord a => Ord (Named a) where
-  compare = compare `on` namedValue
+instance Hashable Name where
+  hashWithSalt salt (Name name) = hashWithSalt salt name
+  hashWithSalt salt (I i)       = salt `hashWithSalt` (1 :: Int) `hashWithSalt` i
+
+instance ToJSON Name where
+  toJSON = toJSON . formatName
+  toEncoding = toEncoding . formatName

semantic-analysis/src/Analysis/Typecheck.hs

@@ -26,8 +26,8 @@ import qualified Analysis.Carrier.Heap.Monovariant as A
 import qualified Analysis.Effect.Domain as A
 import           Analysis.File
 import           Analysis.FlowInsensitive
+import           Analysis.Functor.Named
 import qualified Analysis.Intro as Intro
-import           Analysis.Name
 import           Control.Algebra
 import           Control.Applicative (Alternative (..))
 import           Control.Carrier.Fail.WithLoc
@@ -251,12 +251,12 @@ instance ( Alternative m
       ret <- meta
       unify t (Alg (arg :-> ret))
       b <- concretize ret
-      k (Named (Name mempty) (lift b)) where
+      k (Named (name mempty) (lift b)) where
       concretize = \case
         Alg Unit       -> pure Intro.unit
         Alg Bool       -> pure (Intro.bool True) <|> pure (Intro.bool False)
         Alg String     -> pure (Intro.string mempty)
-        Alg (_ :-> b)  -> send . Intro.Lam . Named (Name mempty) . lift <$> concretize b
+        Alg (_ :-> b)  -> send . Intro.Lam . Named (name mempty) . lift <$> concretize b
         Alg (Record t) -> Intro.record <$> traverse (traverse concretize) (Map.toList t)
         t              -> fail $ "can’t concretize " <> show t -- FIXME: concretize type variables by incrementally solving constraints
     L (R (R (R (R (A.Record fields k))))) -> do

semantic-core/semantic-core.cabal

@@ -49,6 +49,7 @@ library
       base                         >= 4.13 && < 5
     , fused-effects               ^>= 1.0
     , fused-syntax
+    , hashable
     , parsers                     ^>= 0.12.10
     , pathtype                    ^>= 0.8.1
     , prettyprinter                >= 1.2.1 && < 2

semantic-core/src/Core/Name.hs

@@ -1,25 +1,34 @@
-{-# LANGUAGE DeriveGeneric, DeriveTraversable, GeneralizedNewtypeDeriving, LambdaCase, OverloadedLists #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DeriveTraversable #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedLists #-}
+{-# LANGUAGE OverloadedStrings #-}
 module Core.Name
-( module Analysis.Name
+( module Analysis.Functor.Named
 , reservedNames
 , isSimpleCharacter
 , needsQuotation
 ) where
 
-import           Analysis.Name
+import           Analysis.Functor.Named
 import qualified Data.Char as Char
+import           Data.Hashable
 import           Data.HashSet (HashSet)
 import qualified Data.HashSet as HashSet
-import           Data.Text as Text (any, unpack)
+import           Data.String
+import           Data.Text as Text (any)
 
-reservedNames :: HashSet String
+reservedNames :: (Eq s, IsString s, Hashable s) => HashSet s
 reservedNames = [ "#true", "#false", "if", "then", "else"
                 , "#unit", "load", "rec", "#record"]
 
 -- | Returns true if any character would require quotation or if the
 -- name conflicts with a Core primitive.
 needsQuotation :: Name -> Bool
-needsQuotation (Name u) = HashSet.member (unpack u) reservedNames || Text.any (not . isSimpleCharacter) u
+needsQuotation n
+  | isGenerated n = False
+  | otherwise     = HashSet.member n reservedNames || Text.any (not . isSimpleCharacter) (formatName n)
 
 -- | A ‘simple’ character is, loosely defined, a character that is compatible
 -- with identifiers in most ASCII-oriented programming languages. This is defined

semantic-core/src/Core/Parser.hs

@@ -1,4 +1,6 @@
-{-# LANGUAGE FlexibleContexts, GeneralizedNewtypeDeriving, TypeOperators #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE TypeOperators #-}
 module Core.Parser
   ( core
   , lit
@@ -14,7 +16,7 @@ import           Control.Applicative
 import           Control.Monad
 import           Core.Core ((:<-) (..), Core)
 import qualified Core.Core as Core
-import           Core.Name
+import           Core.Name hiding (name)
 import qualified Data.Char as Char
 import           Data.Foldable (foldl')
 import           Data.Function

semantic-core/src/Core/Pretty.hs

@@ -10,7 +10,7 @@ module Core.Pretty
 
 import           Analysis.File
 import           Core.Core
-import           Core.Name
+import           Core.Name hiding (name)
 import           Data.Foldable (toList)
 import           Data.Text.Prettyprint.Doc
 import qualified Data.Text.Prettyprint.Doc.Render.String as Pretty
@@ -43,7 +43,9 @@ primitive = keyword . mappend "#"
 data Style = Unicode | Ascii
 
 name :: Name -> AnsiDoc
-name (Name n) = if needsQuotation (Name n) then enclose (symbol "#{") (symbol "}") (pretty n) else pretty n
+name n
+  | needsQuotation n = enclose (symbol "#{") (symbol "}") (pretty (formatName n))
+  | otherwise        = pretty (formatName n)
 
 prettyCore :: Style -> Term Core Name -> AnsiDoc
 prettyCore style = unPrec . go . fmap name

semantic-core/test/Generators.hs

@@ -1,4 +1,5 @@
-{-# LANGUAGE FlexibleContexts, ScopedTypeVariables #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 
 module Generators
   ( literal
@@ -18,20 +19,21 @@ import qualified Hedgehog.Range as Range
 
 import           Control.Algebra
 import qualified Core.Core as Core
-import           Core.Name
+import           Core.Name (Name, Named)
+import qualified Core.Name as Name
 
 -- The 'prune' call here ensures that we don't spend all our time just generating
 -- fresh names for variables, since the length of variable names is not an
 -- interesting property as they parse regardless.
 name :: MonadGen m => m (Named Name)
-name = Gen.prune (named' <$> names) where
-  names = Name <$> Gen.text (Range.linear 1 10) Gen.lower
+name = Gen.prune (Name.named' <$> names) where
+  names = Name.name <$> Gen.text (Range.linear 1 10) Gen.lower
 
 boolean :: (Has Core.Core sig t, MonadGen m) => m (t Name)
 boolean = Core.bool <$> Gen.bool
 
 variable :: (Applicative t, MonadGen m) => m (t Name)
-variable = pure . namedValue <$> name
+variable = pure . Name.namedValue <$> name
 
 ifthenelse :: (Has Core.Core sig t, MonadGen m) => m (t Name) -> m (t Name)
 ifthenelse bod = Gen.subterm3 boolean bod bod Core.if'
@@ -51,7 +53,7 @@ lambda bod = do
   Gen.subterm bod (Core.lam arg)
 
 record :: (Has Core.Core sig t, MonadGen m) => m (t Name) -> m (t Name)
-record bod = Core.record <$> Gen.list (Range.linear 0 5) ((,) . namedValue <$> name <*> bod)
+record bod = Core.record <$> Gen.list (Range.linear 0 5) ((,) . Name.namedValue <$> name <*> bod)
 
 atoms :: (Has Core.Core sig t, MonadGen m) => [m (t Name)]
 atoms = [variable, pure Core.unit, boolean, Core.string <$> Gen.text (Range.linear 1 10) Gen.lower]
@@ -69,7 +71,7 @@ expr = Gen.recursive Gen.choice atoms
   , Gen.subterm3 expr expr expr Core.if'
   , Gen.subterm expr Core.load
   , record expr
-  , Gen.subtermM expr (\ x -> (x Core....) . namedValue <$> name)
-  , Gen.subtermM expr (\ x -> (x Core..?)  . namedValue <$> name)
+  , Gen.subtermM expr (\ x -> (x Core....) . Name.namedValue <$> name)
+  , Gen.subtermM expr (\ x -> (x Core..?)  . Name.namedValue <$> name)
   , Gen.subterm2 expr expr (Core..=)
   ]

semantic-python/semantic-python.cabal

@@ -24,6 +24,7 @@ common haskell
                      , fused-effects ^>= 1.0
                      , fused-syntax
                      , parsers ^>= 0.12.10
+                     , semantic-analysis ^>= 0
                      , semantic-core ^>= 0.0
                      , semantic-source ^>= 0.0.2
                      , semantic-tags ^>= 0.0

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

@@ -197,7 +197,7 @@ instance Compile Py.Call where
   compile it _ _ = pure . invariantViolated $ "can't compile Call node with generator expression: " <> show it
 
 instance Compile Py.ClassDefinition where
-  compile it@Py.ClassDefinition { body = pybody, name = Py.Identifier _ann (Name -> n) } cc next = do
+  compile it@Py.ClassDefinition { body = pybody, name = Py.Identifier _ann (Name.name -> n) } cc next = do
     let buildTypeCall _ = do
           bindings <- asks @Bindings (toList . unBindings)
           let buildName n = (n, pure n)
@@ -205,7 +205,7 @@ instance Compile Py.ClassDefinition where
               typefn = prelude ["type"]
               object = prelude ["object"]
 
-          pure (typefn $$ Core.string (coerce n) $$ object $$ contents)
+          pure (typefn $$ Core.string (formatName n) $$ object $$ contents)
 
     body <- compile pybody buildTypeCall next
     let coreName = Name.named' n
@@ -244,8 +244,8 @@ instance Compile Py.DottedName where
   compile it@Py.DottedName
     { extraChildren = Py.Identifier { text } :| rest
     } cc _next = do
-    let aggregate Py.Identifier { text = inner } x = x ... Name inner
-        composite = foldr aggregate (pure (Name text)) rest
+    let aggregate Py.Identifier { text = inner } x = x ... Name.name inner
+        composite = foldr aggregate (pure (Name.name text)) rest
     locate it composite & cc
 
 
@@ -287,21 +287,21 @@ instance Compile Py.FunctionDefinition where
           let parameters' = catMaybes parameterMs
           body' <- compile body pure next
           -- Build a lambda.
-          let located = locate it (rec (Name.named' (Name name)) (lams parameters' body'))
+          let located = locate it (rec (Name.named' (Name.name name)) (lams parameters' body'))
           -- Give it a name (below), then augment the current continuation
           -- with the new name (with 'def'), so that calling contexts know
           -- that we have built an exportable definition.
-          assigning located <$> local (def (Name name)) (cc next)
-    where param (Py.Parameter (Prj (Py.Identifier _pann pname))) = Just . named' . Name $ pname
+          assigning located <$> local (def (Name.name name)) (cc next)
+    where param (Py.Parameter (Prj (Py.Identifier _pann pname))) = Just . named' . Name.name $ pname
           param _                                                = Nothing
-          assigning item f = (Name.named' (Name name) :<- item) >>>= f
+          assigning item f = (Name.named' (Name.name name) :<- item) >>>= f
 
 instance Compile Py.FutureImportStatement
 instance Compile Py.GeneratorExpression
 instance Compile Py.GlobalStatement
 
 instance Compile Py.Identifier where
-  compile Py.Identifier { text } cc _ = cc . pure . Name $ text
+  compile Py.Identifier { text } cc _ = cc . pure . Name.name $ text
 
 instance Compile Py.IfStatement where
   compile it@Py.IfStatement{ condition, consequence, alternative} cc next =
@@ -323,7 +323,7 @@ instance Compile Py.Lambda where
     , parameters
     } cc next = do
       let unparams (Py.LambdaParameters _ ps) = toList ps
-          unparam (Py.Parameter (Prj (Py.Identifier _pann pname))) = Just . named' . Name $ pname
+          unparam (Py.Parameter (Prj (Py.Identifier _pann pname))) = Just . named' . Name.name $ pname
           unparam _                                                = Nothing
       body' <- compile body cc next
       let params = maybe [] unparams parameters

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

@@ -9,17 +9,16 @@ module Language.Python.Patterns
   ) where
 
 import           AST.Element
-import           Data.Coerce
-import           Data.Text (Text)
+import qualified Analysis.Name
 import qualified TreeSitter.Python.AST as Py
 
 -- | Useful pattern synonym for extracting a single identifier from
 -- a Python ExpressionList. Easier than pattern-matching every time.
 -- TODO: when this is finished, we won't need this pattern, as we'll
 -- handle ExpressionLists the smart way every time.
-pattern SingleIdentifier :: Coercible t Text => t -> Py.ExpressionList a
-pattern SingleIdentifier name <- Py.ExpressionList
+pattern SingleIdentifier :: Analysis.Name.Name -> Py.ExpressionList a
+pattern SingleIdentifier n <- Py.ExpressionList
   { Py.extraChildren =
-    [ Py.Expression (Prj (Py.PrimaryExpression (Prj Py.Identifier { text = coerce -> name })))
+    [ Py.Expression (Prj (Py.PrimaryExpression (Prj Py.Identifier { text = Analysis.Name.name -> n })))
     ]
   }

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

@@ -23,13 +23,13 @@ module Language.Python.ScopeGraph
   ) where
 
 import           AST.Element
+import qualified Analysis.Name as Name
 import           Control.Algebra (Algebra (..), handleCoercible)
 import           Control.Effect.Fresh
 import           Control.Effect.Sketch
 import           Data.Foldable
 import           Data.Maybe
 import           Data.Monoid
-import qualified Data.Name as Name
 import qualified Data.ScopeGraph as ScopeGraph
 import           Data.Traversable
 import           GHC.Records
@@ -94,7 +94,7 @@ instance ToScopeGraph Py.AssertStatement where scopeGraph = onChildren
 instance ToScopeGraph Py.Assignment where
   scopeGraph (Py.Assignment _ (SingleIdentifier t) _val _typ) = do
     let declProps = (DeclProperties ScopeGraph.Assignment ScopeGraph.Default Nothing)
-    complete <* declare (Name.name t) declProps
+    complete <* declare t declProps
   scopeGraph x                                                = todo x
 
 instance ToScopeGraph Py.Await where

semantic-python/test-graphing/GraphTest.hs

@@ -5,13 +5,13 @@
 {-# LANGUAGE TypeOperators #-}
 module Main (main) where
 
+import           Analysis.Name (Name)
+import qualified Analysis.Name as Name
 import           Control.Algebra
 import           Control.Carrier.Lift
 import           Control.Carrier.Sketch.Fresh
 import           Control.Monad
 import qualified Data.ByteString as ByteString
-import           Data.Name (Name)
-import qualified Data.Name as Name
 import qualified Data.ScopeGraph as ScopeGraph
 import qualified Language.Python ()
 import qualified Language.Python as Py (Term)

semantic-python/test/Instances.hs

@@ -1,4 +1,10 @@
-{-# LANGUAGE DerivingStrategies, GeneralizedNewtypeDeriving, StandaloneDeriving, FlexibleInstances, NamedFieldPuns, OverloadedStrings, QuantifiedConstraints, TypeOperators, UndecidableInstances #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuantifiedConstraints #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableInstances #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module Instances () where
@@ -8,14 +14,10 @@ module Instances () where
 -- we should keep track of them in a dedicated file.
 
 import           Analysis.File
-import           Core.Name (Name (..))
 import           Data.Aeson
 import           Data.Text (pack)
 import qualified System.Path as Path
 
-deriving newtype instance ToJSON Name
-deriving newtype instance ToJSONKey Name
-
 instance ToJSON a => ToJSON (File a) where
   toJSON File{filePath, fileSpan, fileBody} = object
     [ "path" .= filePath

semantic-python/test/Test.hs

@@ -1,4 +1,7 @@
-{-# LANGUAGE OverloadedStrings, ScopedTypeVariables, TypeApplications, TypeOperators #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeOperators #-}
 {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
 module Main (main) where
 
@@ -69,7 +72,7 @@ assertEvaluatesTo core k val = do
     (_, files) ->
       HUnit.assertFailure ("Unexpected number of files: " <> show (length files))
 
-  let found = Map.lookup (Name k) env >>= flip IntMap.lookup heap
+  let found = Map.lookup (name k) env >>= flip IntMap.lookup heap
   found HUnit.@?= Just val
 {-# HLINT ignore assertEvaluatesTo #-}
 

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

@@ -25,7 +25,6 @@ library
     ScopeGraph.Convert
     Data.Hole
     Data.Module
-    Data.Name
     Data.ScopeGraph
   build-depends:
       base                >= 4.13 && < 5
@@ -33,12 +32,13 @@ library
     , algebraic-graphs    >= 0.3 && < 0.5
     , containers
     , fused-effects      ^>= 1.0
+    , generic-monoid
     , hashable
     , lens
-    , semilattices
-    , generic-monoid
     , pathtype
+    , semantic-analysis
     , semantic-source    ^>= 0.0.2
+    , semilattices
     , text               ^>= 1.2.3.1
   hs-source-dirs:      src
   default-language:    Haskell2010

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

@@ -19,17 +19,16 @@ module Control.Carrier.Sketch.Fresh
   , module Control.Effect.Sketch
   ) where
 
-import Control.Algebra
-import Control.Carrier.Fresh.Strict
-import Control.Carrier.State.Strict
-import Control.Effect.Reader
-import Control.Effect.Sketch
-import Control.Monad.IO.Class
-import Data.Bifunctor
---import qualified Data.Map.Strict as Map
+import           Analysis.Name (Name)
+import qualified Analysis.Name as Name
+import           Control.Algebra
+import           Control.Carrier.Fresh.Strict
+import           Control.Carrier.State.Strict
+import           Control.Carrier.Reader
+import           Control.Effect.Sketch
+import           Control.Monad.IO.Class
+import           Data.Bifunctor
 import           Data.Module
-import           Data.Name (Name)
-import qualified Data.Name as Name
 import           Data.ScopeGraph (ScopeGraph)
 import qualified Data.ScopeGraph as ScopeGraph
 import           Data.Semilattice.Lower

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

@@ -33,8 +33,8 @@ import           Control.Effect.Fresh
 import           Control.Effect.Reader
 import           Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Map
-import           Data.Name (Name)
-import qualified Data.Name as Name
+import           Analysis.Name (Name)
+import qualified Analysis.Name as Name
 import qualified Data.ScopeGraph as ScopeGraph
 import           Data.Text (Text)
 import           GHC.Generics (Generic, Generic1)

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

@@ -1,67 +0,0 @@
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE OverloadedStrings #-}
-module Data.Name
-( Name
--- * Constructors
-, gensym
-, name
-, nameI
-, formatName
-, __self
-) where
-
-import           Control.Effect.Fresh
-import           Data.Aeson
-import qualified Data.Char as Char
-import           Data.Hashable
-import           Data.Text (Text)
-import qualified Data.Text as Text
-import Data.String
-
--- | The type of variable names.
-data Name
-  = Name Text
-  | I Int
-  deriving (Eq, Ord)
-
-instance IsString Name where
-  fromString = name . Text.pack
-
--- | Generate a fresh (unused) name for use in synthesized variables/closures/etc.
-gensym :: Has Fresh sig m => m Name
-gensym = I <$> fresh
-
--- | Construct a 'Name' from a 'Text'.
-name :: Text -> Name
-name = Name
-
--- | Construct a 'Name' from an 'Int'. This is suitable for automatic generation, e.g. using a Fresh effect, but should not be used for human-generated names.
-nameI :: Int -> Name
-nameI = I
-
--- | Extract a human-readable 'Text' from a 'Name'.
--- Sample outputs can be found in @Data.Abstract.Name.Spec@.
-formatName :: Name -> Text
-formatName (Name name) = name
-formatName (I i)       = Text.pack $ '_' : (alphabet !! a) : replicate n 'ʹ'
-  where alphabet = ['a'..'z']
-        (n, a) = i `divMod` length alphabet
-
-instance Show Name where
-  showsPrec _ = prettyShowString . Text.unpack . formatName
-    where prettyShowString str = showChar '"' . foldr ((.) . prettyChar) id str . showChar '"'
-          prettyChar c
-            | c `elem` ['\\', '\"'] = Char.showLitChar c
-            | Char.isPrint c        = showChar c
-            | otherwise             = Char.showLitChar c
-
-instance Hashable Name where
-  hashWithSalt salt (Name name) = hashWithSalt salt name
-  hashWithSalt salt (I i)       = salt `hashWithSalt` (1 :: Int) `hashWithSalt` i
-
-instance ToJSON Name where
-  toJSON = toJSON . formatName
-  toEncoding = toEncoding . formatName
-
-__self :: Name
-__self = name "__semantic_self"

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

@@ -48,6 +48,7 @@ module Data.ScopeGraph
 
 import Prelude hiding (lookup)
 
+import           Analysis.Name
 import           Control.Applicative
 import           Control.Lens.Lens
 import           Control.Monad
@@ -61,7 +62,6 @@ import qualified Data.Map.Strict as Map
 import           Data.Maybe
 import           Data.Module
 import           Data.Monoid
-import           Data.Name
 import           Data.Semilattice.Lower
 import           Data.Sequence (Seq)
 import qualified Data.Sequence as Seq

semantic.cabal

@@ -67,7 +67,7 @@ common dependencies
                      , recursion-schemes ^>= 5.1
                      , scientific ^>= 0.3.6.2
                      , safe-exceptions ^>= 0.1.7.0
-                     , semantic-analysis
+                     , semantic-analysis ^>= 0
                      , semantic-source ^>= 0.0.2
                      , semilattices ^>= 0.0.0.3
                      , streaming ^>= 0.2.2.0
@@ -132,7 +132,6 @@ library
                      , Data.Abstract.Live
                      , Data.Abstract.Module
                      , Data.Abstract.ModuleTable
-                     , Data.Abstract.Name
                      , Data.Abstract.Number
                      , Data.Abstract.Package
                      , Data.Abstract.Path

src/Control/Abstract/Heap.hs

@@ -44,6 +44,7 @@ module Control.Abstract.Heap
 , scopeLookup
 ) where
 
+import           Analysis.Name
 import           Control.Abstract.Context (withCurrentCallStack)
 import           Control.Abstract.Evaluator
 import           Control.Abstract.Roots
@@ -58,7 +59,6 @@ import           Data.Abstract.Heap (Heap, Position (..))
 import qualified Data.Abstract.Heap as Heap
 import           Data.Abstract.Live
 import           Data.Abstract.Module (ModuleInfo)
-import           Data.Abstract.Name
 import           Data.Abstract.ScopeGraph (Kind (..), Path (..), putDeclarationScopeAtPosition)
 import qualified Data.Map.Strict as Map
 import           Prologue

src/Control/Abstract/Primitive.hs

@@ -5,6 +5,7 @@ module Control.Abstract.Primitive
   , defineBuiltIn
   ) where
 
+import Analysis.Name
 import Control.Abstract.Context
 import Control.Abstract.Evaluator
 import Control.Abstract.Heap
@@ -12,7 +13,6 @@ import Control.Abstract.ScopeGraph
 import Control.Abstract.Value
 import Data.Abstract.BaseError
 import qualified Data.Abstract.ScopeGraph as ScopeGraph
-import Data.Abstract.Name
 import Data.Map.Strict as Map
 import Prologue
 

src/Control/Abstract/PythonPackage.hs

@@ -2,10 +2,10 @@
 module Control.Abstract.PythonPackage
 ( runPythonPackaging, Strategy(..) ) where
 
+import           Analysis.Name (name)
 import           Control.Abstract as Abstract
 import           Control.Algebra
 import           Control.Effect.Sum.Project
-import           Data.Abstract.Name (name)
 import           Data.Abstract.Path (stripQuotes)
 import           Data.Abstract.Value.Concrete (Value (..))
 import qualified Data.Map as Map

src/Control/Abstract/ScopeGraph.hs

@@ -43,13 +43,13 @@ module Control.Abstract.ScopeGraph
   , ScopeGraph.Path
   ) where
 
+import           Analysis.Name hiding (name)
 import           Control.Abstract.Evaluator hiding (Local)
 import           Control.Algebra
 import qualified Control.Carrier.Resumable.Resume as With
 import qualified Control.Carrier.Resumable.Either as Either
 import           Data.Abstract.BaseError
 import           Data.Abstract.Module
-import           Data.Abstract.Name hiding (name)
 import           Data.Abstract.ScopeGraph (Kind, Declaration(..), EdgeLabel, Reference, Relation(..), Scope (..), ScopeGraph, Slot(..), Info(..), AccessControl(..))
 import qualified Data.Abstract.ScopeGraph as ScopeGraph
 import           Prelude hiding (lookup)

src/Control/Abstract/Value.hs

@@ -72,6 +72,7 @@ module Control.Abstract.Value
 , HashC(..)
 ) where
 
+import Analysis.Name
 import Control.Abstract.Evaluator
 import Control.Abstract.Heap
 import Control.Abstract.ScopeGraph (CurrentScope, Declaration, ScopeGraph)
@@ -79,7 +80,6 @@ import Control.Algebra
 import Control.Carrier.Reader
 import Data.Abstract.BaseError
 import Data.Abstract.Module
-import Data.Abstract.Name
 import Data.Abstract.Number (Number, SomeNumber)
 import Data.Scientific (Scientific)
 import Prelude hiding (String)

src/Data/Abstract/Address/Monovariant.hs

@@ -5,9 +5,9 @@ module Data.Abstract.Address.Monovariant
 
 import Prologue
 
+import Analysis.Name
 import Control.Abstract
 import Control.Algebra
-import Data.Abstract.Name
 import qualified Data.Set as Set
 
 -- | 'Monovariant' models using one address for a particular name. It tracks the set of values that a particular address takes and uses it's name to lookup in the store and only allocation if new.

src/Data/Abstract/Declarations.hs

@@ -4,7 +4,7 @@ module Data.Abstract.Declarations
   , Declarations1 (..)
   ) where
 
-import Data.Abstract.Name
+import Analysis.Name
 import Data.Sum
 import Data.Term
 

src/Data/Abstract/Evaluatable.hs

@@ -15,6 +15,7 @@ module Data.Abstract.Evaluatable
 , runUnspecialized
 , runUnspecializedWith
 , throwUnspecializedError
+, __self
 ) where
 
 import Prologue
@@ -26,6 +27,7 @@ import           Data.Scientific (Scientific)
 import           Data.Semigroup.Foldable
 import           Source.Span (HasSpan(..))
 
+import Analysis.Name as X
 import Control.Abstract hiding (Load, String)
 import qualified Control.Abstract as Abstract
 import Control.Abstract.Context as X
@@ -36,7 +38,6 @@ import Data.Abstract.BaseError as X
 import Data.Abstract.Declarations as X
 import Data.Abstract.FreeVariables as X
 import Data.Abstract.Module
-import Data.Abstract.Name as X
 import qualified Data.Abstract.ScopeGraph as ScopeGraph
 import Data.Abstract.AccessControls.Class as X
 import Data.Language
@@ -116,6 +117,8 @@ class (Show1 constr, Foldable constr) => Evaluatable constr where
 traceResolve :: (Show a, Show b, Has Trace sig m) => a -> b -> Evaluator term address value m ()
 traceResolve name path = trace ("resolved " <> show name <> " -> " <> show path)
 
+__self :: Name
+__self = name "__semantic_self"
 
 -- Preludes
 
@@ -189,7 +192,7 @@ defineSelf :: ( Has (State (ScopeGraph address)) sig m
               )
            => Evaluator term address value m ()
 defineSelf = do
-  let self = Declaration X.__self
+  let self = Declaration __self
   declare self ScopeGraph.Prelude Public lowerBound ScopeGraph.Unknown Nothing
   slot <- lookupSlot self
   assign slot =<< object =<< currentFrame

src/Data/Abstract/FreeVariables.hs

@@ -4,10 +4,10 @@ module Data.Abstract.FreeVariables
   , FreeVariables1 (..)
   ) where
 
-import Data.Abstract.Name
-import           Data.Sum
-import           Data.Term
-import           Prologue
+import Analysis.Name
+import Data.Sum
+import Data.Term
+import Prologue
 
 -- | Types which can contain unbound variables.
 class FreeVariables term where

src/Data/Abstract/Name.hs

@@ -1,5 +0,0 @@
-module Data.Abstract.Name
-  ( module X
-  ) where
-
-import Data.Name as X

src/Data/Abstract/Package.hs

@@ -6,10 +6,10 @@ module Data.Abstract.Package
   , Data.Abstract.Package.fromModules
   ) where
 
+import Analysis.Name
 import Data.Abstract.Module
 import Data.Abstract.ModuleTable as ModuleTable
 import qualified Data.Map as Map
-import Data.Abstract.Name
 
 type PackageName = Name
 

src/Data/Abstract/Value/Concrete.hs

@@ -17,15 +17,15 @@ import qualified Data.Map.Strict as Map
 import           Data.Scientific.Exts
 import           Data.Text (pack)
 
+import           Analysis.Name
 import           Control.Abstract hiding
     (Array (..), Boolean (..), Function (..), Hash (..), Numeric (..), Object (..), String (..), Unit (..), While (..))
 import qualified Control.Abstract as Abstract
 import           Control.Algebra
 import           Control.Effect.Interpose
 import           Data.Abstract.BaseError
-import           Data.Abstract.Evaluatable (Declarations, EvalError (..), UnspecializedError (..))
+import           Data.Abstract.Evaluatable (Declarations, EvalError (..), UnspecializedError (..), __self)
 import           Data.Abstract.FreeVariables
-import           Data.Abstract.Name
 import qualified Data.Abstract.Number as Number
 
 

src/Data/Graph/ControlFlowVertex.hs

@@ -14,9 +14,9 @@ module Data.Graph.ControlFlowVertex
 , VertexDeclaration1 (..)
 ) where
 
+import           Analysis.Name
 import           Data.Abstract.Declarations
 import           Data.Abstract.Module (ModuleInfo (..))
-import           Data.Abstract.Name
 import           Data.Abstract.Package (PackageInfo (..))
 import           Data.Aeson
 import           Data.Graph (VertexTag (..))

src/Data/ImportPath.hs

@@ -3,7 +3,7 @@ module Data.ImportPath (IsRelative(..), ImportPath(..), importPath, toName, defa
 
 import Prologue
 
-import           Data.Abstract.Name
+import           Analysis.Name
 import           Data.Abstract.Path (stripQuotes)
 import           Data.Aeson
 import qualified Data.Text as T

src/Data/Syntax/Expression.hs

@@ -4,9 +4,9 @@ module Data.Syntax.Expression (module Data.Syntax.Expression) where
 import Prelude hiding (null)
 import Prologue hiding (index, null)
 
+import           Analysis.Name as Name
 import           Control.Abstract hiding (Bitwise (..), Call)
 import           Data.Abstract.Evaluatable as Abstract
-import           Data.Abstract.Name as Name
 import           Data.Abstract.Number (liftIntegralFrac, liftReal, liftedExponent, liftedFloorDiv)
 import           Data.Fixed
 import           Data.JSON.Fields

src/Language/Go/Assignment.hs

@@ -8,10 +8,10 @@ module Language.Go.Assignment
 
 import Prologue
 
+import           Analysis.Name (name)
 import           Assigning.Assignment hiding (Assignment, Error)
 import qualified Assigning.Assignment as Assignment
 import qualified Data.Abstract.ScopeGraph as ScopeGraph (AccessControl(..))
-import           Data.Abstract.Name (name)
 import           Data.Syntax
     (contextualize, emptyTerm, handleError, infixContext, makeTerm, makeTerm', makeTerm'', makeTerm1, parseError)
 import qualified Data.Syntax as Syntax

src/Language/PHP/Assignment.hs

@@ -8,9 +8,9 @@ module Language.PHP.Assignment
 
 import Prologue
 
+import qualified Analysis.Name as Name
 import           Assigning.Assignment hiding (Assignment, Error)
 import qualified Assigning.Assignment as Assignment
-import qualified Data.Abstract.Name as Name
 import qualified Data.Abstract.ScopeGraph as ScopeGraph (AccessControl(..))
 import qualified Data.List.NonEmpty as NonEmpty
 import           Data.Syntax

src/Language/Python/Assignment.hs

@@ -6,9 +6,9 @@ module Language.Python.Assignment
 , Python.Term(..)
 ) where
 
+import           Analysis.Name (name)
 import           Assigning.Assignment hiding (Assignment, Error)
 import qualified Assigning.Assignment as Assignment
-import           Data.Abstract.Name (name)
 import qualified Data.List.NonEmpty as NonEmpty
 import           Data.Sum
 import           Data.Syntax

src/Language/Ruby/Assignment.hs

@@ -8,9 +8,9 @@ module Language.Ruby.Assignment
 
 import Prologue hiding (for, unless)
 
+import           Analysis.Name (name)
 import           Assigning.Assignment hiding (Assignment, Error)
 import qualified Assigning.Assignment as Assignment
-import           Data.Abstract.Name (name)
 import qualified Data.Abstract.ScopeGraph as ScopeGraph (AccessControl(..))
 import qualified Data.List.NonEmpty as NonEmpty
 import           Data.Syntax

src/Language/Ruby/Syntax.hs

@@ -3,11 +3,11 @@ module Language.Ruby.Syntax (module Language.Ruby.Syntax) where
 
 import Prologue
 
+import           Analysis.Name as Name
 import           Control.Abstract as Abstract hiding (Load, String)
 import           Data.Abstract.BaseError
 import           Data.Abstract.Evaluatable
 import qualified Data.Abstract.Module as M
-import           Data.Abstract.Name as Name
 import           Data.Abstract.Path
 import qualified Data.Abstract.ScopeGraph as ScopeGraph
 import           Data.JSON.Fields

src/Language/TSX/Assignment.hs

@@ -6,8 +6,8 @@ module Language.TSX.Assignment
 , TSX.Term(..)
 ) where
 
+import Analysis.Name (name)
 import Assigning.Assignment hiding (Assignment, Error)
-import Data.Abstract.Name (name)
 import qualified Data.Abstract.ScopeGraph as ScopeGraph (AccessControl(..))
 import qualified Assigning.Assignment as Assignment
 import Data.Sum

src/Language/TypeScript/Assignment.hs

@@ -6,8 +6,8 @@ module Language.TypeScript.Assignment
 , TypeScript.Term(..)
 ) where
 
+import Analysis.Name (name)
 import Assigning.Assignment hiding (Assignment, Error)
-import Data.Abstract.Name (name)
 import qualified Data.Abstract.ScopeGraph as ScopeGraph (AccessControl(..))
 import qualified Assigning.Assignment as Assignment
 import Data.Sum

src/Language/TypeScript/Syntax/Import.hs

@@ -3,9 +3,9 @@ module Language.TypeScript.Syntax.Import (module Language.TypeScript.Syntax.Impo
 
 import Prologue
 
+import qualified Analysis.Name as Name
 import           Control.Abstract hiding (Import)
 import           Data.Abstract.Evaluatable as Evaluatable
-import qualified Data.Abstract.Name as Name
 import qualified Data.Abstract.ScopeGraph as ScopeGraph
 import           Data.JSON.Fields
 import           Diffing.Algorithm

src/Tags/Taggable.hs

@@ -27,8 +27,8 @@ import Prologue
 
 import Analysis.ConstructorName
 import Analysis.HasTextElement
+import Analysis.Name
 import Data.Abstract.Declarations
-import Data.Abstract.Name
 import Data.Language
 import Data.Term
 import Data.Text hiding (empty)

test/Data/Abstract/Name/Spec.hs

@@ -3,7 +3,7 @@ module Data.Abstract.Name.Spec (spec) where
 import SpecHelpers
 
 spec :: Spec
-spec = describe "Data.Abstract.Name" $
+spec = describe "Analysis.Name" $
   it "should format anonymous names correctly" $ do
     show (nameI 0)  `shouldBe` "\"_a\""
     show (nameI 26) `shouldBe` "\"_aʹ\""

test/Data/Functor/Listable.hs

@@ -16,6 +16,7 @@ module Data.Functor.Listable
 , ListableSyntax
 ) where
 
+import qualified Analysis.Name as Name
 import qualified Analysis.TOCSummary as ToC
 import Data.Abstract.ScopeGraph (AccessControl(..))
 import Data.Bifunctor.Join
@@ -27,7 +28,6 @@ import qualified Data.Syntax as Syntax
 import qualified Data.Syntax.Comment as Comment
 import qualified Data.Syntax.Declaration as Declaration
 import qualified Data.Syntax.Statement as Statement
-import qualified Data.Abstract.Name as Name
 import Data.Term
 import Data.Text as T (Text, pack)
 import Data.Sum

test/SpecHelpers.hs

@@ -25,6 +25,7 @@ module SpecHelpers
 ) where
 
 import qualified Analysis.File as File
+import           Analysis.Name as X
 import           Control.Abstract
 import           Control.Carrier.Fresh.Strict
 import           Control.Carrier.Lift
@@ -41,7 +42,6 @@ import           Data.Abstract.FreeVariables as X
 import qualified Data.Abstract.Heap as Heap
 import           Data.Abstract.Module as X
 import           Data.Abstract.ModuleTable as X hiding (lookup)
-import           Data.Abstract.Name as X
 import qualified Data.Abstract.ScopeGraph as ScopeGraph
 import           Data.Abstract.Value.Concrete (Value (..), ValueError, runValueError)
 import           Data.Blob as X
@@ -60,7 +60,6 @@ import           Data.Project as X
 import           Data.Proxy as X
 import           Data.Semigroup as X (Semigroup (..))
 import           Data.Semilattice.Lower as X
-import           Data.String
 import           Data.Sum as Sum
 import           Data.Term as X
 import           Data.Traversable as X (for)
@@ -86,11 +85,6 @@ import           Unsafe.Coerce (unsafeCoerce)
 runBuilder :: Builder -> ByteString
 runBuilder = toStrict . toLazyByteString
 
--- | This orphan instance is so we don't have to insert @name@ calls
--- in dozens and dozens of environment specs.
-instance IsString Name where
-  fromString = X.name . fromString
-
 -- | Returns an s-expression formatted diff for the specified FilePath pair.
 diffFilePaths :: TaskSession -> Path.RelFile -> Path.RelFile -> IO ByteString
 diffFilePaths session p1 p2 = do