Rename User to Name

semantic-core/src/Analysis/Concrete.hs

@@ -34,13 +34,13 @@ import           Data.Traversable (for)
 import           Prelude hiding (fail)
 
 type Precise = Int
-type Env = Map.Map User Precise
+type Env = Map.Map Name Precise
 
 newtype FrameId = FrameId { unFrameId :: Precise }
   deriving (Eq, Ord, Show)
 
 data Concrete term
-  = Closure Loc User term Env
+  = Closure Loc Name term Env
   | Unit
   | Bool Bool
   | String Text
@@ -69,15 +69,15 @@ data Edge = Lexical | Import
 --   >>> map fileBody (snd (concrete eval [File (Loc "bool" emptySpan) (Core.bool True)]))
 --   [Right (Bool True)]
 concrete
-  :: (Foldable term, Show (term User))
+  :: (Foldable term, Show (term Name))
   => (forall sig m
      .  (Carrier sig m, Member (Reader Loc) sig, MonadFail m)
-     => Analysis (term User) Precise (Concrete (term User)) m
-     -> (term User -> m (Concrete (term User)))
-     -> (term User -> m (Concrete (term User)))
+     => Analysis (term Name) Precise (Concrete (term Name)) m
+     -> (term Name -> m (Concrete (term Name)))
+     -> (term Name -> m (Concrete (term Name)))
      )
-  -> [File (term User)]
-  -> (Heap (term User), [File (Either (Loc, String) (Concrete (term User)))])
+  -> [File (term Name)]
+  -> (Heap (term Name), [File (Either (Loc, String) (Concrete (term Name)))])
 concrete eval
   = run
   . runFresh
@@ -89,17 +89,17 @@ runFile
      , Effect sig
      , Foldable term
      , Member Fresh sig
-     , Member (State (Heap (term User))) sig
-     , Show (term User)
+     , Member (State (Heap (term Name))) sig
+     , Show (term Name)
      )
   => (forall sig m
      .  (Carrier sig m, Member (Reader Loc) sig, MonadFail m)
-     => Analysis (term User) Precise (Concrete (term User)) m
-     -> (term User -> m (Concrete (term User)))
-     -> (term User -> m (Concrete (term User)))
+     => Analysis (term Name) Precise (Concrete (term Name)) m
+     -> (term Name -> m (Concrete (term Name)))
+     -> (term Name -> m (Concrete (term Name)))
      )
-  -> File (term User)
-  -> m (File (Either (Loc, String) (Concrete (term User))))
+  -> File (term Name)
+  -> m (File (Either (Loc, String) (Concrete (term Name))))
 runFile eval file = traverse run file
   where run = runReader (fileLoc file)
             . runFailWithLoc
@@ -111,11 +111,11 @@ concreteAnalysis :: ( Carrier sig m
                     , Member Fresh sig
                     , Member (Reader Env) sig
                     , Member (Reader Loc) sig
-                    , Member (State (Heap (term User))) sig
+                    , Member (State (Heap (term Name))) sig
                     , MonadFail m
-                    , Show (term User)
+                    , Show (term Name)
                     )
-                 => Analysis (term User) Precise (Concrete (term User)) m
+                 => Analysis (term Name) Precise (Concrete (term Name)) m
 concreteAnalysis = Analysis{..}
   where alloc _ = fresh
         bind name addr m = local (Map.insert name addr) m
@@ -151,7 +151,7 @@ concreteAnalysis = Analysis{..}
           pure (val >>= lookupConcrete heap n)
 
 
-lookupConcrete :: Heap term -> User -> Concrete term -> Maybe Precise
+lookupConcrete :: Heap term -> Name -> Concrete term -> Maybe Precise
 lookupConcrete heap name = run . evalState IntSet.empty . runNonDet . inConcrete
   where -- look up the name in a concrete value
         inConcrete = inFrame <=< maybeA . recordFrame
@@ -177,7 +177,7 @@ runHeap = runState mempty
 --   > λ let (heap, res) = concrete [ruby]
 --   > λ writeFile "/Users/rob/Desktop/heap.dot" (export (addressStyle heap) (heapAddressGraph heap))
 --   > λ :!dot -Tsvg < ~/Desktop/heap.dot > ~/Desktop/heap.svg
-heapGraph :: (Precise -> Concrete term -> a) -> (Either Edge User -> Precise -> G.Graph a) -> Heap term -> G.Graph a
+heapGraph :: (Precise -> Concrete term -> a) -> (Either Edge Name -> Precise -> G.Graph a) -> Heap term -> G.Graph a
 heapGraph vertex edge h = foldr (uncurry graph) G.empty (IntMap.toList h)
   where graph k v rest = (G.vertex (vertex k v) `G.connect` outgoing v) `G.overlay` rest
         outgoing = \case
@@ -211,7 +211,7 @@ addressStyle heap = (G.defaultStyle vertex) { G.edgeAttributes }
 
 data EdgeType term
   = Edge Edge
-  | Slot User
+  | Slot Name
   | Value (Concrete term)
   deriving (Eq, Ord, Show)
 

semantic-core/src/Analysis/Eval.hs

@@ -33,9 +33,9 @@ eval :: ( Carrier sig m
         , MonadFail m
         , Semigroup value
         )
-     => Analysis (Term (Ann :+: Core) User) address value m
-     -> (Term (Ann :+: Core) User -> m value)
-     -> (Term (Ann :+: Core) User -> m value)
+     => Analysis (Term (Ann :+: Core) Name) address value m
+     -> (Term (Ann :+: Core) Name -> m value)
+     -> (Term (Ann :+: Core) Name -> m value)
 eval Analysis{..} eval = \case
   Var n -> lookupEnv' n >>= deref' n
   Term (R c) -> case c of
@@ -93,30 +93,30 @@ eval Analysis{..} eval = \case
           Term (L (Ann loc c)) -> local (const loc) (ref c)
 
 
-prog1 :: (Carrier sig t, Member Core sig) => File (t User)
+prog1 :: (Carrier sig t, Member Core sig) => File (t Name)
 prog1 = fromBody $ lam (named' "foo")
   (    named' "bar" :<- pure "foo"
   >>>= Core.if' (pure "bar")
     (Core.bool False)
     (Core.bool True))
 
-prog2 :: (Carrier sig t, Member Core sig) => File (t User)
+prog2 :: (Carrier sig t, Member Core sig) => File (t Name)
 prog2 = fromBody $ fileBody prog1 $$ Core.bool True
 
-prog3 :: (Carrier sig t, Member Core sig) => File (t User)
+prog3 :: (Carrier sig t, Member Core sig) => File (t Name)
 prog3 = fromBody $ lams [named' "foo", named' "bar", named' "quux"]
   (Core.if' (pure "quux")
     (pure "bar")
     (pure "foo"))
 
-prog4 :: (Carrier sig t, Member Core sig) => File (t User)
+prog4 :: (Carrier sig t, Member Core sig) => File (t Name)
 prog4 = fromBody
   (    named' "foo" :<- Core.bool True
   >>>= Core.if' (pure "foo")
     (Core.bool True)
     (Core.bool False))
 
-prog5 :: (Carrier sig t, Member Ann sig, Member Core sig) => File (t User)
+prog5 :: (Carrier sig t, Member Ann sig, Member Core sig) => File (t Name)
 prog5 = fromBody $ ann (do'
   [ Just (named' "mkPoint") :<- lams [named' "_x", named' "_y"] (ann (Core.record
     [ ("x", ann (pure "_x"))
@@ -127,7 +127,7 @@ prog5 = fromBody $ ann (do'
   , Nothing :<- ann (ann (pure "point") Core.... "y") .= ann (ann (pure "point") Core.... "x")
   ])
 
-prog6 :: (Carrier sig t, Member Core sig) => [File (t User)]
+prog6 :: (Carrier sig t, Member Core sig) => [File (t Name)]
 prog6 =
   [ File (Loc "dep"  (locSpan (fromJust here))) $ Core.record
     [ ("dep", Core.record [ ("var", Core.bool True) ]) ]
@@ -137,7 +137,7 @@ prog6 =
     ])
   ]
 
-ruby :: (Carrier sig t, Member Ann sig, Member Core sig) => File (t User)
+ruby :: (Carrier sig t, Member Ann sig, Member Core sig) => File (t Name)
 ruby = fromBody $ annWith callStack (rec (named' __semantic_global) (do' statements))
   where statements =
           [ Just "Class" :<- record
@@ -215,18 +215,18 @@ ruby = fromBody $ annWith callStack (rec (named' __semantic_global) (do' stateme
 
 
 data Analysis term address value m = Analysis
-  { alloc     :: User -> m address
-  , bind      :: forall a . User -> address -> m a -> m a
-  , lookupEnv :: User -> m (Maybe address)
+  { alloc     :: Name -> m address
+  , bind      :: forall a . Name -> address -> m a -> m a
+  , lookupEnv :: Name -> m (Maybe address)
   , deref     :: address -> m (Maybe value)
   , assign    :: address -> value -> m ()
-  , abstract  :: (term -> m value) -> User -> term -> m value
+  , abstract  :: (term -> m value) -> Name -> term -> m value
   , apply     :: (term -> m value) -> value -> value -> m value
   , unit      :: m value
   , bool      :: Bool -> m value
   , asBool    :: value -> m Bool
   , string    :: Text -> m value
   , asString  :: value -> m Text
-  , record    :: [(User, value)] -> m value
-  , (...)     :: address -> User -> m (Maybe address)
+  , record    :: [(Name, value)] -> m value
+  , (...)     :: address -> Name -> m (Maybe address)
   }

semantic-core/src/Analysis/ImportGraph.hs

@@ -41,7 +41,7 @@ instance Monoid (Value term) where
   mempty = Value Abstract mempty
 
 data Semi term
-  = Closure Loc User term
+  = Closure Loc Name term
   -- FIXME: Bound String values.
   | String Text
   | Abstract
@@ -52,12 +52,12 @@ importGraph
   :: (Ord term, Show term)
   => (forall sig m
      .  (Carrier sig m, Member (Reader Loc) sig, MonadFail m)
-     => Analysis term User (Value term) m
+     => Analysis term Name (Value term) m
      -> (term -> m (Value term))
      -> (term -> m (Value term))
      )
   -> [File term]
-  -> ( Heap User (Value term)
+  -> ( Heap Name (Value term)
      , [File (Either (Loc, String) (Value term))]
      )
 importGraph eval
@@ -70,13 +70,13 @@ runFile
   :: ( Carrier sig m
      , Effect sig
      , Member Fresh sig
-     , Member (State (Heap User (Value term))) sig
+     , Member (State (Heap Name (Value term))) sig
      , Ord  term
      , Show term
      )
   => (forall sig m
      .  (Carrier sig m, Member (Reader Loc) sig, MonadFail m)
-     => Analysis term User (Value term) m
+     => Analysis term Name (Value term) m
      -> (term -> m (Value term))
      -> (term -> m (Value term))
      )
@@ -86,18 +86,18 @@ runFile eval file = traverse run file
   where run = runReader (fileLoc file)
             . runFailWithLoc
             . fmap fold
-            . convergeTerm (Proxy @User) (fix (cacheTerm . eval importGraphAnalysis))
+            . convergeTerm (Proxy @Name) (fix (cacheTerm . eval importGraphAnalysis))
 
 -- FIXME: decompose into a product domain and two atomic domains
 importGraphAnalysis :: ( Alternative m
                        , Carrier sig m
                        , Member (Reader Loc) sig
-                       , Member (State (Heap User (Value term))) sig
+                       , Member (State (Heap Name (Value term))) sig
                        , MonadFail m
                        , Ord  term
                        , Show term
                        )
-                    => Analysis term User (Value term) m
+                    => Analysis term Name (Value term) m
 importGraphAnalysis = Analysis{..}
   where alloc = pure
         bind _ _ m = m

semantic-core/src/Analysis/ScopeGraph.hs

@@ -50,12 +50,12 @@ scopeGraph
   :: Ord term
   => (forall sig m
      .  (Carrier sig m, Member (Reader Loc) sig, MonadFail m)
-     => Analysis term User ScopeGraph m
+     => Analysis term Name ScopeGraph m
      -> (term -> m ScopeGraph)
      -> (term -> m ScopeGraph)
      )
   -> [File term]
-  -> (Heap User ScopeGraph, [File (Either (Loc, String) ScopeGraph)])
+  -> (Heap Name ScopeGraph, [File (Either (Loc, String) ScopeGraph)])
 scopeGraph eval
   = run
   . runFresh
@@ -66,32 +66,32 @@ runFile
   :: ( Carrier sig m
      , Effect sig
      , Member Fresh sig
-     , Member (State (Heap User ScopeGraph)) sig
+     , Member (State (Heap Name ScopeGraph)) sig
      , Ord term
      )
   => (forall sig m
      .  (Carrier sig m, Member (Reader Loc) sig, MonadFail m)
-     => Analysis term User ScopeGraph m
+     => Analysis term Name ScopeGraph m
      -> (term -> m ScopeGraph)
      -> (term -> m ScopeGraph)
      )
   -> File term
   -> m (File (Either (Loc, String) ScopeGraph))
 runFile eval file = traverse run file
   where run = runReader (fileLoc file)
-            . runReader (Map.empty @User @Loc)
+            . runReader (Map.empty @Name @Loc)
             . runFailWithLoc
             . fmap fold
-            . convergeTerm (Proxy @User) (fix (cacheTerm . eval scopeGraphAnalysis))
+            . convergeTerm (Proxy @Name) (fix (cacheTerm . eval scopeGraphAnalysis))
 
 scopeGraphAnalysis
   :: ( Alternative m
      , Carrier sig m
      , Member (Reader Loc) sig
-     , Member (Reader (Map.Map User Loc)) sig
-     , Member (State (Heap User ScopeGraph)) sig
+     , Member (Reader (Map.Map Name Loc)) sig
+     , Member (State (Heap Name ScopeGraph)) sig
      )
-  => Analysis term User ScopeGraph m
+  => Analysis term Name ScopeGraph m
 scopeGraphAnalysis = Analysis{..}
   where alloc = pure
         bind name _ m = do

semantic-core/src/Analysis/Typecheck.hs

@@ -43,7 +43,7 @@ data Monotype f a
   | Unit
   | String
   | Arr (f a) (f a)
-  | Record (Map.Map User (f a))
+  | Record (Map.Map Name (f a))
   deriving (Foldable, Functor, Generic1, Traversable)
 
 type Type = Term Monotype Meta
@@ -95,12 +95,12 @@ typecheckingFlowInsensitive
   :: Ord term
   => (forall sig m
      .  (Carrier sig m, Member (Reader Loc) sig, MonadFail m)
-     => Analysis term User Type m
+     => Analysis term Name Type m
      -> (term -> m Type)
      -> (term -> m Type)
      )
   -> [File term]
-  -> ( Heap User Type
+  -> ( Heap Name Type
      , [File (Either (Loc, String) (Term (Polytype :+: Monotype) Void))]
      )
 typecheckingFlowInsensitive eval
@@ -114,12 +114,12 @@ runFile
   :: ( Carrier sig m
      , Effect sig
      , Member Fresh sig
-     , Member (State (Heap User Type)) sig
+     , Member (State (Heap Name Type)) sig
      , Ord term
      )
   => (forall sig m
      .  (Carrier sig m, Member (Reader Loc) sig, MonadFail m)
-     => Analysis term User Type m
+     => Analysis term Name Type m
      -> (term -> m Type)
      -> (term -> m Type)
      )
@@ -129,7 +129,7 @@ runFile eval file = traverse run file
   where run
           = (\ m -> do
               (subst, t) <- m
-              modify @(Heap User Type) (fmap (Set.map (substAll subst)))
+              modify @(Heap Name Type) (fmap (Set.map (substAll subst)))
               pure (substAll subst <$> t))
           . runState (mempty :: Substitution)
           . runReader (fileLoc file)
@@ -142,16 +142,16 @@ runFile eval file = traverse run file
               v <- meta
               bs <- m
               v <$ for_ bs (unify v))
-          . convergeTerm (Proxy @User) (fix (cacheTerm . eval typecheckingAnalysis))
+          . convergeTerm (Proxy @Name) (fix (cacheTerm . eval typecheckingAnalysis))
 
 typecheckingAnalysis
   :: ( Alternative m
      , Carrier sig m
      , Member Fresh sig
      , Member (State (Set.Set Constraint)) sig
-     , Member (State (Heap User Type)) sig
+     , Member (State (Heap Name Type)) sig
      )
-  => Analysis term User Type m
+  => Analysis term Name Type m
 typecheckingAnalysis = Analysis{..}
   where alloc = pure
         bind _ _ m = m