Merge pull request #2175 from github/scopes-and-frames

Scopes and frames

semantic.cabal

@@ -46,6 +46,7 @@ library
                      , Control.Abstract.Primitive
                      , Control.Abstract.PythonPackage
                      , Control.Abstract.Roots
+                     , Control.Abstract.ScopeGraph
                      , Control.Abstract.TermEvaluator
                      , Control.Abstract.Value
                      -- Datatypes for abstract interpretation
@@ -70,6 +71,7 @@ library
                      , Data.Abstract.Package
                      , Data.Abstract.Path
                      , Data.Abstract.Ref
+                     , Data.Abstract.ScopeGraph
                      , Data.Abstract.Value.Abstract
                      , Data.Abstract.Value.Concrete
                      , Data.Abstract.Value.Type

src/Control/Abstract/Context.hs

@@ -8,11 +8,13 @@ module Control.Abstract.Context
 , Span
 , currentSpan
 , withCurrentSpan
+, modifyChildSpan
 , withCurrentCallStack
 ) where
 
 import Control.Monad.Effect
 import Control.Monad.Effect.Reader
+import Control.Monad.Effect.State
 import Data.Abstract.Module
 import Data.Abstract.Package
 import Data.Span
@@ -43,6 +45,8 @@ currentSpan = ask
 withCurrentSpan :: (Effectful m, Member (Reader Span) effects) => Span -> m effects a -> m effects a
 withCurrentSpan = local . const
 
+modifyChildSpan :: (Effectful m, Member (State Span) effects) => Span -> m effects a -> m effects a
+modifyChildSpan span m = raiseEff (lowerEff m >>= (\a -> modify' (const span) >> pure a))
 
 -- | Run an action with locally-replaced 'ModuleInfo' & 'Span' derived from the passed 'SrcLoc'.
 withCurrentSrcLoc :: (Effectful m, Member (Reader ModuleInfo) effects, Member (Reader Span) effects) => SrcLoc -> m effects a -> m effects a

src/Control/Abstract/Modules.hs

@@ -30,8 +30,9 @@ import qualified Data.Set as Set
 import Data.Span
 import Prologue
 import System.FilePath.Posix (takeDirectory)
+import Data.Abstract.ScopeGraph
 
-type ModuleResult address = (Bindings address, address)
+type ModuleResult address = (ScopeGraph address, (Bindings address, address))
 
 -- | Retrieve an evaluated module, if any. @Nothing@ means we’ve never tried to load it, and @Just (env, value)@ indicates the result of a completed load.
 lookupModule :: Member (Modules address) effects => ModulePath -> Evaluator address value effects (Maybe (ModuleResult address))
@@ -94,7 +95,7 @@ askModuleTable = ask
 newtype Merging address = Merging { runMerging :: ModuleResult address }
 
 instance Semigroup (Merging address) where
-  Merging (binds1, _) <> Merging (binds2, addr) = Merging (binds1 <> binds2, addr)
+  Merging (_, (binds1, _)) <> Merging (graph2, (binds2, addr)) = Merging (graph2, (binds1 <> binds2, addr))
 
 
 -- | An error thrown when loading a module from the list of provided modules. Indicates we weren't able to find a module with the given name.

src/Control/Abstract/ScopeGraph.hs

@@ -0,0 +1,98 @@
+{-# LANGUAGE GADTs, KindSignatures, LambdaCase, RankNTypes, ScopedTypeVariables, TypeOperators #-}
+module Control.Abstract.ScopeGraph
+  ( runScopeEnv
+  , ScopeEnv
+  , lookup
+  , declare
+  , reference
+  , newScope
+  , Declaration(..)
+  , Reference(..)
+  , EdgeLabel(..)
+  , currentScope
+  , withScope
+  , associatedScope
+  , putDeclarationScope
+  ) where
+
+import           Control.Abstract.Evaluator hiding (Local)
+import           Control.Abstract.Heap
+import           Data.Abstract.Name
+import           Data.Abstract.ScopeGraph (Declaration (..), EdgeLabel, Reference, ScopeGraph)
+import qualified Data.Abstract.ScopeGraph as ScopeGraph
+import           Data.Span
+import           Prelude hiding (lookup)
+import           Prologue
+
+data ScopeEnv address (m :: * -> *) a where
+    Lookup :: Reference -> ScopeEnv address m (Maybe address)
+    Declare :: Declaration -> Span -> Maybe address -> ScopeEnv address m ()
+    PutDeclarationScope :: Declaration -> address -> ScopeEnv address m ()
+    Reference :: Reference -> Declaration -> ScopeEnv address m ()
+    NewScope :: Map EdgeLabel [address] -> ScopeEnv address m address
+    CurrentScope :: ScopeEnv address m (Maybe address)
+    Local :: address -> m a -> ScopeEnv address m a
+    AssociatedScope :: Declaration -> ScopeEnv address m (Maybe address)
+
+lookup :: forall address value effects. Member (ScopeEnv address) effects => Reference -> Evaluator address value effects (Maybe address)
+lookup = send . Lookup @address
+
+declare :: forall address value effects. Member (ScopeEnv address) effects => Declaration -> Span -> Maybe address -> Evaluator address value effects ()
+declare = ((send .) .) . Declare @address
+
+putDeclarationScope :: forall address value effects. Member (ScopeEnv address) effects => Declaration -> address -> Evaluator address value effects ()
+putDeclarationScope = (send .) . PutDeclarationScope @address
+
+reference :: forall address value effects. Member (ScopeEnv address) effects => Reference -> Declaration -> Evaluator address value effects ()
+reference = (send .) . Reference @address
+
+newScope :: forall address value effects. (Member (ScopeEnv address) effects) => Map EdgeLabel [address]  -> Evaluator address value effects address
+newScope map = send (NewScope map)
+
+currentScope :: forall address value effects. Member (ScopeEnv address) effects => Evaluator address value effects (Maybe address)
+currentScope = send CurrentScope
+
+associatedScope :: forall address value effects. Member (ScopeEnv address) effects => Declaration -> Evaluator address value effects (Maybe address)
+associatedScope = send . AssociatedScope
+
+withScope :: forall address value effects m a. (Effectful (m address value), Member (ScopeEnv address) effects) => address -> m address value effects a -> m address value effects a
+withScope scope action = send (Local scope (lowerEff action))
+
+instance PureEffect (ScopeEnv address)
+instance Effect (ScopeEnv address) where
+  handleState c dist (Request (Lookup ref) k)         = Request (Lookup ref) (dist . (<$ c) . k)
+  handleState c dist (Request (Declare decl span assocScope) k) = Request (Declare decl span assocScope) (dist . (<$ c) . k)
+  handleState c dist (Request (PutDeclarationScope decl assocScope) k) = Request (PutDeclarationScope decl assocScope) (dist . (<$ c) . k)
+  handleState c dist (Request (Reference ref decl) k) = Request (Reference ref decl) (dist . (<$ c) . k)
+  handleState c dist (Request (NewScope edges) k)       = Request (NewScope edges) (dist . (<$ c) . k)
+  handleState c dist (Request CurrentScope k)         = Request CurrentScope (dist . (<$ c) . k)
+  handleState c dist (Request (AssociatedScope decl) k)         = Request (AssociatedScope decl) (dist . (<$ c) . k)
+  handleState c dist (Request (Local scope action) k) = Request (Local scope (dist (action <$ c))) (dist . fmap k)
+
+
+runScopeEnv :: (Ord address, Effects effects, Member Fresh effects, Member (Allocator address) effects)
+            => Evaluator address value (ScopeEnv address ': effects) a
+            -> Evaluator address value effects (ScopeGraph address, a)
+runScopeEnv evaluator = runState lowerBound (reinterpret handleScopeEnv evaluator)
+
+handleScopeEnv :: forall address value effects a. (Ord address, Member Fresh effects, Member (Allocator address) effects, Effects effects)
+          => ScopeEnv address (Eff (ScopeEnv address ': effects)) a
+          -> Evaluator address value (State (ScopeGraph address) ': effects) a
+handleScopeEnv = \case
+    Lookup ref -> ScopeGraph.scopeOfRef ref <$> get
+    Declare decl span scope -> modify @(ScopeGraph address) (ScopeGraph.declare decl span scope)
+    PutDeclarationScope decl scope -> modify @(ScopeGraph address) (ScopeGraph.insertDeclarationScope decl scope)
+    Reference ref decl -> modify @(ScopeGraph address) (ScopeGraph.reference ref decl)
+    NewScope edges -> do
+        -- Take the edges and construct a new scope, update the current scope to the new scope
+        name <- gensym
+        address <- alloc name
+        address <$ modify @(ScopeGraph address) (ScopeGraph.newScope address edges)
+    CurrentScope -> ScopeGraph.currentScope <$> get
+    AssociatedScope decl -> ScopeGraph.associatedScope decl <$> get
+    Local scope action -> do
+        prevScope <- ScopeGraph.currentScope <$> get
+        modify @(ScopeGraph address) (\g -> g { ScopeGraph.currentScope = Just scope })
+        value <- reinterpret handleScopeEnv (raiseEff action)
+        modify @(ScopeGraph address) (\g -> g { ScopeGraph.currentScope = prevScope })
+        pure value

src/Data/Abstract/Evaluatable.hs

@@ -28,6 +28,7 @@ import Control.Abstract.Evaluator as X hiding (LoopControl(..), Return(..), catc
 import Control.Abstract.Heap as X hiding (runAddressError, runAddressErrorWith)
 import Control.Abstract.Modules as X (Modules, ModuleResult, ResolutionError(..), load, lookupModule, listModulesInDir, require, resolve, throwResolutionError)
 import Control.Abstract.Value as X hiding (Boolean(..), Function(..))
+import Control.Abstract.ScopeGraph
 import Data.Abstract.Declarations as X
 import Data.Abstract.Environment as X
 import Data.Abstract.BaseError as X
@@ -53,6 +54,7 @@ class (Show1 constr, Foldable constr) => Evaluatable constr where
           , Member (Allocator address) effects
           , Member (Boolean value) effects
           , Member (Deref value) effects
+          , Member (ScopeEnv address) effects
           , Member (Env address) effects
           , Member (Exc (LoopControl address)) effects
           , Member (Exc (Return address)) effects
@@ -62,6 +64,7 @@ class (Show1 constr, Foldable constr) => Evaluatable constr where
           , Member (Reader ModuleInfo) effects
           , Member (Reader PackageInfo) effects
           , Member (Reader Span) effects
+          , Member (State Span) effects
           , Member (Resumable (BaseError (AddressError address value))) effects
           , Member (Resumable (BaseError (EnvironmentError address))) effects
           , Member (Resumable (BaseError (UnspecializedError value))) effects
@@ -82,6 +85,7 @@ type ModuleEffects address value rest
   =  Exc (LoopControl address)
   ': Exc (Return address)
   ': Env address
+  ': ScopeEnv address
   ': Deref value
   ': Allocator address
   ': Reader ModuleInfo
@@ -104,6 +108,7 @@ evaluate :: ( AbstractValue address value valueEffects
             , Member (Reader (ModuleTable (NonEmpty (Module (ModuleResult address))))) effects
             , Member (Reader PackageInfo) effects
             , Member (Reader Span) effects
+            , Member (State Span) effects
             , Member (Resumable (BaseError (AddressError address value))) effects
             , Member (Resumable (BaseError (EnvironmentError address))) effects
             , Member (Resumable (BaseError EvalError)) effects
@@ -124,7 +129,7 @@ evaluate :: ( AbstractValue address value valueEffects
          -> [Module term]
          -> TermEvaluator term address value effects (ModuleTable (NonEmpty (Module (ModuleResult address))))
 evaluate lang analyzeModule analyzeTerm runAllocDeref runValue modules = do
-  (preludeBinds, _) <- TermEvaluator . runInModule lowerBound moduleInfoFromCallStack . runValue $ do
+  (_, (preludeBinds, _)) <- TermEvaluator . runInModule lowerBound moduleInfoFromCallStack . runValue $ do
     definePrelude lang
     box unit
   foldr (run preludeBinds) ask modules
@@ -143,6 +148,7 @@ evaluate lang analyzeModule analyzeTerm runAllocDeref runValue modules = do
         runInModule preludeBinds info
           = runReader info
           . runAllocDeref
+          . runScopeEnv
           . runEnv (EvalContext Nothing (X.push (newEnv preludeBinds)))
           . runReturn
           . runLoopControl

src/Data/Abstract/ScopeGraph.hs

@@ -0,0 +1,242 @@
+{-# LANGUAGE GADTs #-}
+module Data.Abstract.ScopeGraph
+  ( ScopeGraph(..)
+  , Path
+  , pathDeclaration
+  , Reference(..)
+  , Declaration(..)
+  , EdgeLabel(..)
+  , Frame
+  , Heap
+  , frameLookup
+  , scopeLookup
+  , frameSlots
+  , frameLinks
+  , getSlot
+  , setSlot
+  , lookup
+  , scopeOfRef
+  , pathOfRef
+  , declare
+  , reference
+  , newScope
+  , associatedScope
+  , insertDeclarationScope
+  , newFrame
+  , initFrame
+  , insertFrame
+  , fillFrame
+  , deleteFrame
+  , heapSize
+  ) where
+
+import           Data.Abstract.Name
+import qualified Data.Map.Strict as Map
+import           Data.Span
+import           Prelude hiding (lookup)
+import           Prologue
+
+data Scope scopeAddress = Scope {
+    edges        :: Map EdgeLabel [scopeAddress] -- Maybe Map EdgeLabel [Path scope]?
+  , references   :: Map Reference (Path scopeAddress)
+  , declarations :: Map Declaration (Span, Maybe scopeAddress)
+  } deriving (Eq, Show, Ord)
+
+
+data ScopeGraph scope = ScopeGraph { graph :: Map scope (Scope scope), currentScope :: Maybe scope }
+
+instance Ord scope => Lower (ScopeGraph scope) where
+  lowerBound = ScopeGraph mempty Nothing
+
+deriving instance Eq address => Eq (ScopeGraph address)
+deriving instance Show address => Show (ScopeGraph address)
+deriving instance Ord address => Ord (ScopeGraph address)
+
+data Path scope where
+  -- | Construct a direct path to a declaration.
+  DPath :: Declaration -> Path scope
+  -- | Construct an edge from a scope to another declaration path.
+  EPath :: EdgeLabel -> scope -> Path scope -> Path scope
+
+deriving instance Eq scope => Eq (Path scope)
+deriving instance Show scope => Show (Path scope)
+deriving instance Ord scope => Ord (Path scope)
+
+-- Returns the declaration of a path.
+pathDeclaration :: Path scope -> Declaration
+pathDeclaration (DPath d)     = d
+pathDeclaration (EPath _ _ p) = pathDeclaration p
+
+-- Returns the reference paths of a scope in a scope graph.
+pathsOfScope :: Ord scope => scope -> ScopeGraph scope -> Maybe (Map Reference (Path scope))
+pathsOfScope scope = fmap references . Map.lookup scope . graph
+
+-- Returns the declaration data of a scope in a scope graph.
+ddataOfScope :: Ord scope => scope -> ScopeGraph scope -> Maybe (Map Declaration (Span, Maybe scope))
+ddataOfScope scope = fmap declarations . Map.lookup scope . graph
+
+-- 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 . graph
+
+-- Lookup a scope in the scope graph.
+lookupScope :: Ord scope => scope -> ScopeGraph scope -> Maybe (Scope scope)
+lookupScope scope = Map.lookup scope . graph
+
+-- Declare a declaration with a span and an associated scope in the scope graph.
+declare :: Ord scope => Declaration -> Span -> Maybe scope -> ScopeGraph scope -> ScopeGraph scope
+declare declaration ddata assocScope g@ScopeGraph{..} = fromMaybe g $ do
+  scopeKey <- currentScope
+  scope <- lookupScope scopeKey g
+  let newScope = scope { declarations = Map.insert declaration (ddata, assocScope) (declarations scope) }
+  pure $ g { graph = Map.insert scopeKey newScope graph }
+
+-- | 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 -> Declaration -> ScopeGraph scope -> ScopeGraph scope
+reference ref declaration g@ScopeGraph{..} = fromMaybe g $ do
+  currentAddress <- currentScope
+  currentScope' <- lookupScope currentAddress g
+  go currentAddress currentScope' currentAddress id
+  where
+    declDataOfScope address = do
+      dataMap <- ddataOfScope address g
+      Map.lookup declaration dataMap
+    go currentAddress currentScope address path =
+      case declDataOfScope address of
+          Just _ ->
+            let newScope = currentScope { references = Map.insert ref (path (DPath declaration)) (references currentScope) }
+            in Just (g { graph = Map.insert currentAddress newScope graph })
+          Nothing -> let
+            traverseEdges edge = do
+              linkMap <- linksOfScope address g
+              scopes <- Map.lookup edge linkMap
+              -- Return the first path to the declaration through the scopes.
+              getFirst (foldMap (First . ap (go currentAddress currentScope) ((path .) . EPath edge)) scopes)
+            in traverseEdges Import <|> traverseEdges Lexical
+
+-- | Insert associate the given address to a declaration in the scope graph.
+insertDeclarationScope :: Ord address => Declaration -> address -> ScopeGraph address -> ScopeGraph address
+insertDeclarationScope decl address g@ScopeGraph{..} = fromMaybe g $ do
+  declScope <- scopeOfDeclaration decl g
+  scope <- lookupScope declScope g
+  (span, _) <- Map.lookup decl (declarations scope)
+  pure $ g { graph = Map.insert declScope (scope { declarations = Map.insert decl (span, Just address) (declarations scope) }) graph }
+
+-- | 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 g@ScopeGraph{..} = g { graph = Map.insert address newScope graph }
+  where
+    newScope = Scope edges mempty mempty
+
+-- | Returns the scope of a reference in the scope graph.
+scopeOfRef :: Ord scope => Reference -> ScopeGraph scope -> Maybe scope
+scopeOfRef ref g@ScopeGraph{..} = 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
+  Map.lookup ref pathsMap
+
+-- Returns the scope the declaration was declared in.
+scopeOfDeclaration :: Ord scope => Declaration -> ScopeGraph scope -> Maybe scope
+scopeOfDeclaration declaration g@ScopeGraph{..} = go (Map.keys graph)
+  where
+    go (s : scopes') = fromMaybe (go scopes') $ do
+      ddataMap <- ddataOfScope s g
+      _ <- Map.lookup declaration ddataMap
+      pure (Just s)
+    go [] = 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{..} = go (Map.keys graph)
+  where
+    go (s : scopes') = fromMaybe (go scopes') $ do
+      ddataMap <- ddataOfScope s g
+      (_, assocScope) <- Map.lookup declaration ddataMap
+      pure assocScope
+    go [] = Nothing
+
+newtype Reference = Reference Name
+  deriving (Eq, Ord, Show)
+
+newtype Declaration = Declaration Name
+  deriving (Eq, Ord, Show)
+
+-- | 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
+  deriving (Eq, Ord, Show)
+
+data Frame scopeAddress frameAddress value = Frame {
+    scopeAddress :: scopeAddress
+  , links        :: Map EdgeLabel (Map scopeAddress frameAddress)
+  , slots        :: Map Declaration value
+  }
+
+newtype Heap scopeAddress frameAddress value = Heap { unHeap :: Map frameAddress (Frame scopeAddress frameAddress value) }
+
+-- | Look up the frame for an 'address' in a 'Heap', if any.
+frameLookup :: Ord address => address -> Heap scope address value -> Maybe (Frame scope address value)
+frameLookup address = Map.lookup address . unHeap
+
+-- | Look up the scope address for a given frame address.
+scopeLookup :: Ord address => address -> Heap scope address value -> Maybe scope
+scopeLookup address = fmap scopeAddress . frameLookup address
+
+frameSlots :: Ord address => address -> Heap scope address value -> Maybe (Map Declaration value)
+frameSlots address = fmap slots . frameLookup address
+
+frameLinks :: Ord address => address -> Heap scope address value -> Maybe (Map EdgeLabel (Map scope address))
+frameLinks address = fmap links . frameLookup address
+
+getSlot :: Ord address => address -> Heap scope address value -> Declaration -> Maybe value
+getSlot address heap declaration = do
+  slotMap <- frameSlots address heap
+  Map.lookup declaration slotMap
+
+setSlot :: Ord address => address -> Declaration -> value -> Heap scope address value -> Heap scope address value
+setSlot address declaration value heap =
+    case frameLookup address heap of
+      Just frame -> let slotMap = slots frame in
+        Heap $ Map.insert address (frame { slots = Map.insert declaration value slotMap }) (unHeap heap)
+      Nothing -> heap
+
+lookup :: (Ord address, Ord scope) => Heap scope address value -> address -> Path scope -> Declaration -> Maybe scope
+lookup heap address (DPath d) declaration = guard (d == declaration) >> scopeLookup address heap
+lookup heap address (EPath label scope path) declaration = do
+    frame <- frameLookup address heap
+    scopeMap <- Map.lookup label (links frame)
+    nextAddress <- Map.lookup scope scopeMap
+    lookup heap nextAddress path declaration
+
+newFrame :: (Ord address) => scope -> address -> Map EdgeLabel (Map scope address) -> Heap scope address value -> Heap scope address value
+newFrame scope address links = insertFrame address (Frame scope links mempty)
+
+initFrame :: (Ord address) => scope -> address -> Map EdgeLabel (Map scope address) -> Map Declaration value -> Heap scope address value -> Heap scope address value
+initFrame scope address links slots = fillFrame address slots . newFrame scope address links
+
+insertFrame :: Ord address => address -> Frame scope address value -> Heap scope address value -> Heap scope address value
+insertFrame address frame = Heap . Map.insert address frame . unHeap
+
+fillFrame :: Ord address => address -> Map Declaration value -> Heap scope address value -> Heap scope address value
+fillFrame address slots heap =
+  case frameLookup address heap of
+    Just frame -> insertFrame address (frame { slots = slots }) heap
+    Nothing    -> heap
+
+deleteFrame :: Ord address => address -> Heap scope address value -> Heap scope address value
+deleteFrame address = Heap . Map.delete address . unHeap
+
+-- | The number of frames in the `Heap`.
+heapSize :: Heap scope address value -> Int
+heapSize = Map.size . unHeap

src/Data/Syntax/Declaration.hs

@@ -1,14 +1,16 @@
-{-# LANGUAGE DeriveAnyClass, MultiParamTypeClasses, ScopedTypeVariables, UndecidableInstances #-}
+{-# LANGUAGE DeriveAnyClass, MultiParamTypeClasses, ScopedTypeVariables, UndecidableInstances, TupleSections #-}
 {-# OPTIONS_GHC -Wno-missing-export-lists #-}
 module Data.Syntax.Declaration where
 
 import qualified Data.Abstract.Environment as Env
 import           Data.Abstract.Evaluatable
+import           Control.Abstract.ScopeGraph
 import           Data.JSON.Fields
 import qualified Data.Set as Set
 import           Diffing.Algorithm
 import           Prologue
 import           Proto3.Suite.Class
+import qualified Data.Map.Strict as Map
 import           Reprinting.Tokenize
 
 data Function a = Function { functionContext :: ![a], functionName :: !a, functionParameters :: ![a], functionBody :: !a }
@@ -125,7 +127,18 @@ instance Show1 VariableDeclaration where liftShowsPrec = genericLiftShowsPrec
 
 instance Evaluatable VariableDeclaration where
   eval (VariableDeclaration [])   = rvalBox unit
-  eval (VariableDeclaration decs) = rvalBox =<< tuple =<< traverse subtermAddress decs
+  eval (VariableDeclaration decs) = do
+    addresses <- for decs $ \declaration -> do
+      name <- maybeM (throwEvalError NoNameError) (declaredName (subterm declaration))
+      (span, valueRef) <- do
+        ref <- subtermRef declaration
+        subtermSpan <- get @Span
+        pure (subtermSpan, ref)
+
+      declare (Declaration name) span Nothing -- TODO is it true that variable declarations never have an associated scope?
+
+      address valueRef
+    rvalBox =<< tuple addresses
 
 instance Declarations a => Declarations (VariableDeclaration a) where
   declaredName (VariableDeclaration vars) = case vars of
@@ -158,7 +171,13 @@ instance Ord1 PublicFieldDefinition where liftCompare = genericLiftCompare
 instance Show1 PublicFieldDefinition where liftShowsPrec = genericLiftShowsPrec
 
 -- TODO: Implement Eval instance for PublicFieldDefinition
-instance Evaluatable PublicFieldDefinition
+instance Evaluatable PublicFieldDefinition where
+  eval PublicFieldDefinition{..} = do
+    span <- ask @Span
+    propertyName <- maybeM (throwEvalError NoNameError) (declaredName (subterm publicFieldPropertyName))
+    declare (Declaration propertyName) span Nothing
+    rvalBox unit
+
 
 
 data Variable a = Variable { variableName :: !a, variableType :: !a, variableValue :: !a }
@@ -187,14 +206,31 @@ instance Show1 Class where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable Class where
   eval Class{..} = do
     name <- maybeM (throwEvalError NoNameError) (declaredName (subterm classIdentifier))
-    supers <- traverse subtermAddress classSuperclasses
+    span <- ask @Span
+    -- Run the action within the class's scope.
+    currentScope' <- currentScope
+
+    supers <- for classSuperclasses $ \superclass -> do
+      name <- maybeM (throwEvalError NoNameError) (declaredName (subterm superclass))
+      scope <- associatedScope (Declaration name)
+      (scope,) <$> subtermAddress superclass
+
+    let imports = (Import,) <$> (fmap pure . catMaybes $ fst <$> supers)
+        current = maybe mempty (fmap (Lexical, ) . pure . pure) currentScope'
+        edges = Map.fromList (imports <> current)
+    childScope <- newScope edges
+    declare (Declaration name) span (Just childScope)
+
+    withScope childScope $ do
       (_, addr) <- letrec name $ do
         void $ subtermValue classBody
         classBinds <- Env.head <$> getEnv
-      klass name supers classBinds
+        klass name (snd <$> supers) classBinds
       bind name addr
       pure (Rval addr)
 
+
+
 -- | A decorator in Python
 data Decorator a = Decorator { decoratorIdentifier :: !a, decoratorParamaters :: ![a], decoratorBody :: !a }
   deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, Named1, Message1)

src/Data/Syntax/Expression.hs

@@ -2,6 +2,7 @@
 {-# OPTIONS_GHC -Wno-missing-export-lists #-}
 module Data.Syntax.Expression where
 
+import Control.Abstract.ScopeGraph as ScopeGraph
 import Data.Abstract.Evaluatable hiding (Member)
 import Data.Abstract.Number (liftIntegralFrac, liftReal, liftedExponent, liftedFloorDiv)
 import Data.Bits
@@ -424,7 +425,10 @@ instance Evaluatable Complement where
 
 -- | Member Access (e.g. a.b)
 data MemberAccess a = MemberAccess { lhs :: a, rhs :: Name }
-  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, Named1, Message1)
+  deriving (Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, Named1, Message1)
+
+instance Declarations1 MemberAccess where
+  liftDeclaredName _ MemberAccess{..} = Just rhs
 
 instance Eq1 MemberAccess where liftEq = genericLiftEq
 instance Ord1 MemberAccess where liftCompare = genericLiftCompare
@@ -432,7 +436,17 @@ instance Show1 MemberAccess where liftShowsPrec = genericLiftShowsPrec
 
 instance Evaluatable MemberAccess where
   eval (MemberAccess obj propName) = do
+    name <- maybeM (throwEvalError NoNameError) (declaredName (subterm obj))
+    reference (Reference name) (Declaration name)
+    childScope <- associatedScope (Declaration name)
+
     ptr <- subtermAddress obj
+    case childScope of
+      Just childScope -> withScope childScope $ reference (Reference propName) (Declaration propName)
+      Nothing ->
+        -- TODO: Throw an ReferenceError because we can't find the associated child scope for `obj`.
+        pure ()
+
     pure $! LvalMember ptr propName
 
 -- | Subscript (e.g a[1])
@@ -523,14 +537,26 @@ instance Evaluatable Await where
 
 -- | An object constructor call in Javascript, Java, etc.
 newtype New a = New { newSubject :: [a] }
-  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, Named1, Message1)
+  deriving (Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, Named1, Message1)
+
+instance Declarations1 New where
+  liftDeclaredName _ (New []) = Nothing
+  liftDeclaredName declaredName (New (subject : _)) = declaredName subject
 
 instance Eq1 New where liftEq = genericLiftEq
 instance Ord1 New where liftCompare = genericLiftCompare
 instance Show1 New where liftShowsPrec = genericLiftShowsPrec
 
 -- TODO: Implement Eval instance for New
-instance Evaluatable New
+instance Evaluatable New where
+  eval New{..} = do
+    case newSubject of
+      [] -> pure ()
+      (subject : _) -> do
+        name <- maybeM (throwEvalError NoNameError) (declaredName (subterm subject))
+        reference (Reference name) (Declaration name)
+    -- TODO: Traverse subterms and instantiate frames from the corresponding scope
+    rvalBox unit
 
 -- | A cast expression to a specified type.
 data Cast a =  Cast { castSubject :: !a, castType :: !a }

src/Data/Syntax/Statement.hs

@@ -3,6 +3,8 @@
 module Data.Syntax.Statement where
 
 import Data.Abstract.Evaluatable
+import Control.Abstract.ScopeGraph
+import qualified Data.Map.Strict as Map
 import Data.Aeson (ToJSON1 (..))
 import Data.JSON.Fields
 import Data.Semigroup.App
@@ -27,7 +29,11 @@ instance Show1 Statements where liftShowsPrec = genericLiftShowsPrec
 instance ToJSON1 Statements
 
 instance Evaluatable Statements where
-  eval (Statements xs) = maybe (rvalBox unit) (runApp . foldMap1 (App . subtermRef)) (nonEmpty xs)
+  eval (Statements xs) = do
+    currentScope' <- currentScope
+    let edges = maybe mempty (Map.singleton Lexical . pure) currentScope'
+    scope <- newScope edges
+    withScope scope $ maybe (rvalBox unit) (runApp . foldMap1 (App . subtermRef)) (nonEmpty xs)
 
 instance Tokenize Statements where
   tokenize = imperative
@@ -121,7 +127,10 @@ instance Evaluatable Let where
 
 -- | Assignment to a variable or other lvalue.
 data Assignment a = Assignment { assignmentContext :: ![a], assignmentTarget :: !a, assignmentValue :: !a }
-  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, Named1, Message1)
+  deriving (Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, Named1, Message1)
+
+instance Declarations1 Assignment where
+  liftDeclaredName declaredName Assignment{..} = declaredName assignmentTarget
 
 instance Eq1 Assignment where liftEq = genericLiftEq
 instance Ord1 Assignment where liftCompare = genericLiftCompare
@@ -133,8 +142,19 @@ instance Evaluatable Assignment where
     rhs <- subtermAddress assignmentValue
 
     case lhs of
-      LvalLocal nam -> do
+      LvalLocal name -> do
-        bind nam rhs
+        case declaredName (subterm assignmentValue) of
+          Just rhsName -> do
+            assocScope <- associatedScope (Declaration rhsName)
+            case assocScope of
+              Just assocScope' -> do
+                objectScope <- newScope (Map.singleton Import [ assocScope' ])
+                putDeclarationScope (Declaration name) objectScope
+              Nothing -> pure ()
+          Nothing ->
+            -- The rhs wasn't assigned to a reference/declaration.
+            pure ()
+        bind name rhs
       LvalMember _ _ ->
         -- we don't yet support mutable object properties:
         pure ()

src/Language/Go/Syntax.hs

@@ -93,7 +93,7 @@ instance Evaluatable Import where
     paths <- resolveGoImport importPath
     for_ paths $ \path -> do
       traceResolve (unPath importPath) path
-      importedEnv <- fst <$> require path
+      importedEnv <- fst . snd <$> require path
       bindAll importedEnv
     rvalBox unit
 
@@ -115,7 +115,7 @@ instance Evaluatable QualifiedImport where
     void . letrec' alias $ \addr -> do
       makeNamespace alias addr Nothing . for_ paths $ \p -> do
         traceResolve (unPath importPath) p
-        importedEnv <- fst <$> require p
+        importedEnv <- fst . snd <$> require p
         bindAll importedEnv
     rvalBox unit
 

src/Language/PHP/Syntax.hs

@@ -71,7 +71,7 @@ include pathTerm f = do
   name <- subtermValue pathTerm >>= asString
   path <- resolvePHPName name
   traceResolve name path
-  (importedEnv, v) <- f path
+  (_, (importedEnv, v)) <- f path
   bindAll importedEnv
   pure (Rval v)
 

src/Language/Python/Syntax.hs

@@ -145,7 +145,7 @@ instance Evaluatable Import where
 
     -- Last module path is the one we want to import
     let path = NonEmpty.last modulePaths
-    importedBinds <- fst <$> require path
+    importedBinds <- fst . snd <$> require path
     bindAll (select importedBinds)
     rvalBox unit
     where
@@ -165,7 +165,7 @@ evalQualifiedImport :: ( AbstractValue address value effects
                        )
                     => Name -> ModulePath -> Evaluator address value effects value
 evalQualifiedImport name path = letrec' name $ \addr -> do
-  unit <$ makeNamespace name addr Nothing (bindAll . fst =<< require path)
+  unit <$ makeNamespace name addr Nothing (bindAll . fst . snd =<< require path)
 
 newtype QualifiedImport a = QualifiedImport { qualifiedImportFrom :: NonEmpty FilePath }
   deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Named1, Ord, Show, ToJSONFields1, Traversable)
@@ -218,7 +218,7 @@ instance Evaluatable QualifiedAliasedImport where
     alias <- maybeM (throwEvalError NoNameError) (declaredName (subterm aliasTerm))
     rvalBox =<< letrec' alias (\addr -> do
       let path = NonEmpty.last modulePaths
-      unit <$ makeNamespace alias addr Nothing (void (bindAll . fst =<< require path)))
+      unit <$ makeNamespace alias addr Nothing (void (bindAll . fst . snd =<< require path)))
 
 -- | Ellipsis (used in splice expressions and alternatively can be used as a fill in expression, like `undefined` in Haskell)
 data Ellipsis a = Ellipsis

src/Language/Ruby/Syntax.hs

@@ -98,8 +98,8 @@ doRequire :: ( Member (Boolean value) effects
 doRequire path = do
   result <- lookupModule path
   case result of
-    Nothing       -> (,) . fst <$> load path <*> boolean True
+    Nothing       -> (,) . fst . snd <$> load path <*> boolean True
-    Just (env, _) -> (env,) <$> boolean False
+    Just (_, (env, _)) -> (env,) <$> boolean False
 
 
 data Load a = Load { loadPath :: a, loadWrap :: Maybe a }
@@ -132,7 +132,7 @@ doLoad :: ( Member (Boolean value) effects
 doLoad path shouldWrap = do
   path' <- resolveRubyPath path
   traceResolve path path'
-  importedEnv <- fst <$> load path'
+  importedEnv <- fst . snd <$> load path'
   unless shouldWrap $ bindAll importedEnv
   boolean Prelude.True -- load always returns true. http://ruby-doc.org/core-2.5.0/Kernel.html#method-i-load
 

src/Language/TypeScript/Assignment.hs

@@ -620,7 +620,7 @@ constructorTy :: Assignment Term
 constructorTy = makeTerm <$> symbol ConstructorType <*> children (TypeScript.Syntax.Constructor <$> (fromMaybe <$> emptyTerm <*> optional (term typeParameters)) <*> formalParameters <*> term ty)
 
 statementBlock :: Assignment Term
-statementBlock = makeTerm <$> symbol StatementBlock <*> children (manyTerm statement)
+statementBlock = makeTerm <$> symbol StatementBlock <*> children (Statement.Statements <$> manyTerm statement)
 
 classBodyStatements :: Assignment Term
 classBodyStatements = makeTerm'' <$> symbol ClassBody <*> children (contextualize' <$> Assignment.manyThrough comment (postContextualize' <$> (concat <$> many ((\as b -> as <> [b]) <$> manyTerm decorator <*> term (methodDefinition <|> publicFieldDefinition <|> methodSignature <|> indexSignature <|> abstractMethodSignature))) <*> many comment))

src/Language/TypeScript/Resolution.hs

@@ -175,4 +175,4 @@ evalRequire :: ( AbstractValue address value effects
             -> Name
             -> Evaluator address value effects value
 evalRequire modulePath alias = letrec' alias $ \addr ->
-  unit <$ makeNamespace alias addr Nothing (bindAll . fst =<< require modulePath)
+  unit <$ makeNamespace alias addr Nothing (bindAll . fst . snd =<< require modulePath)

src/Language/TypeScript/Syntax/TypeScript.hs

@@ -10,6 +10,7 @@ import           Proto3.Suite
 
 import qualified Data.Abstract.Environment as Env
 import           Data.Abstract.Evaluatable
+import           Control.Abstract.ScopeGraph hiding (Import)
 import           Data.JSON.Fields
 import           Diffing.Algorithm
 import           Language.TypeScript.Resolution
@@ -25,7 +26,7 @@ instance Show1 Import where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable Import where
   eval (Import symbols importPath) = do
     modulePath <- resolveWithNodejsStrategy importPath typescriptExtensions
-    importedBinds <- fst <$> require modulePath
+    importedBinds <- fst . snd <$> require modulePath
     bindAll (renamed importedBinds)
     rvalBox unit
     where
@@ -92,7 +93,7 @@ instance Show1 QualifiedExportFrom where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable QualifiedExportFrom where
   eval (QualifiedExportFrom importPath exportSymbols) = do
     modulePath <- resolveWithNodejsStrategy importPath typescriptExtensions
-    importedBinds <- fst <$> require modulePath
+    importedBinds <- fst . snd <$> require modulePath
     -- Look up addresses in importedEnv and insert the aliases with addresses into the exports.
     for_ exportSymbols $ \Alias{..} -> do
       let address = Env.lookup aliasValue importedBinds
@@ -271,15 +272,24 @@ newtype PredefinedType a = PredefinedType { predefinedType :: T.Text }
 instance Eq1 PredefinedType where liftEq = genericLiftEq
 instance Ord1 PredefinedType where liftCompare = genericLiftCompare
 instance Show1 PredefinedType where liftShowsPrec = genericLiftShowsPrec
+-- TODO: Implement Eval instance for PredefinedType
 instance Evaluatable PredefinedType
 
 newtype TypeIdentifier a = TypeIdentifier { contents :: T.Text }
-  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Message1, Named1, Ord, Show, ToJSONFields1, Traversable)
+  deriving (Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Message1, Named1, Ord, Show, ToJSONFields1, Traversable)
+
+instance Declarations1 TypeIdentifier where
+  liftDeclaredName _ (TypeIdentifier identifier) = Just (name identifier)
 
 instance Eq1 TypeIdentifier where liftEq = genericLiftEq
 instance Ord1 TypeIdentifier where liftCompare = genericLiftCompare
 instance Show1 TypeIdentifier where liftShowsPrec = genericLiftShowsPrec
-instance Evaluatable TypeIdentifier
+-- TODO: TypeIdentifier shouldn't evaluate to an address in the heap?
+instance Evaluatable TypeIdentifier where
+  eval TypeIdentifier{..} = do
+    -- Add a reference to the type identifier in the current scope.
+    reference (Reference (name contents)) (Declaration (name contents))
+    rvalBox unit
 
 data NestedIdentifier a = NestedIdentifier { left :: !a, right :: !a }
   deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Message1, Named1, Ord, Show, ToJSONFields1, Traversable)
@@ -343,12 +353,21 @@ instance Declarations a => Declarations (EnumDeclaration a) where
   declaredName EnumDeclaration{..} = declaredName enumDeclarationIdentifier
 
 newtype ExtendsClause a = ExtendsClause { extendsClauses :: [a] }
-  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Message1, Named1, Ord, Show, ToJSONFields1, Traversable)
+  deriving (Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Message1, Named1, Ord, Show, ToJSONFields1, Traversable)
+
+instance Declarations1 ExtendsClause where
+  liftDeclaredName _ (ExtendsClause []) = Nothing
+  liftDeclaredName declaredName (ExtendsClause (x : _)) = declaredName x
 
 instance Eq1 ExtendsClause where liftEq = genericLiftEq
 instance Ord1 ExtendsClause where liftCompare = genericLiftCompare
 instance Show1 ExtendsClause where liftShowsPrec = genericLiftShowsPrec
-instance Evaluatable ExtendsClause
+-- TODO: ExtendsClause shouldn't evaluate to an address in the heap?
+instance Evaluatable ExtendsClause where
+  eval ExtendsClause{..} = do
+    -- Evaluate subterms
+    traverse_ subtermRef extendsClauses
+    rvalBox unit
 
 newtype ArrayType a = ArrayType { arrayType :: a }
   deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Message1, Named1, Ord, Show, ToJSONFields1, Traversable)

src/Semantic/Graph.hs

@@ -122,6 +122,7 @@ runCallGraph lang includePackages modules package = do
         . resumingAddressError
         . runReader (packageInfo package)
         . runReader (lowerBound @Span)
+        . runState (lowerBound @Span)
         . runReader (lowerBound @ControlFlowVertex)
         . providingLiveSet
         . runReader (lowerBound @(ModuleTable (NonEmpty (Module (ModuleResult (Hole (Maybe Name) (Located Monovariant)))))))
@@ -192,6 +193,7 @@ runImportGraph lang (package :: Package term) f =
         . runModules (ModuleTable.modulePaths (packageModules package))
         . runTermEvaluator @_ @_ @(Value (Hole (Maybe Name) Precise) (ConcreteEff (Hole (Maybe Name) Precise) _))
         . runReader (packageInfo package)
+        . runState lowerBound
         . runReader lowerBound
       runAddressEffects
         = Hole.runAllocator Precise.handleAllocator
@@ -200,6 +202,7 @@ runImportGraph lang (package :: Package term) f =
 
 type ConcreteEffects address rest
   =  Reader Span
+  ': State Span
   ': Reader PackageInfo
   ': Modules address
   ': Reader (ModuleTable (NonEmpty (Module (ModuleResult address))))
@@ -273,6 +276,7 @@ parsePythonPackage parser project = do
         . runModules lowerBound
         . runTermEvaluator @_ @_ @(Value (Hole (Maybe Name) Precise) (ConcreteEff (Hole (Maybe Name) Precise) _))
         . runReader (PackageInfo (name "setup") lowerBound)
+        . runState lowerBound
         . runReader lowerBound
       runAddressEffects
         = Hole.runAllocator Precise.handleAllocator
@@ -322,10 +326,13 @@ parseModule proj parser file = do
 
 withTermSpans :: ( HasField fields Span
                  , Member (Reader Span) effects
+                 , Member (State Span) effects -- last evaluated child's span
                  )
               => SubtermAlgebra (TermF syntax (Record fields)) term (TermEvaluator term address value effects a)
               -> SubtermAlgebra (TermF syntax (Record fields)) term (TermEvaluator term address value effects a)
-withTermSpans recur term = withCurrentSpan (getField (termFAnnotation term)) (recur term)
+withTermSpans recur term = let
+  updatedSpanAlg = withCurrentSpan (getField (termFAnnotation term)) (recur term)
+  in modifyChildSpan (getField (termFAnnotation term)) updatedSpanAlg
 
 resumingResolutionError :: ( Applicative (m effects)
                            , Effectful m
@@ -343,11 +350,12 @@ resumingLoadError :: ( Applicative (m address value effects)
                      , Effectful (m address value)
                      , Effects effects
                      , Member Trace effects
+                     , Ord address
                      )
                   => m address value (Resumable (BaseError (LoadError address)) ': effects) a
                   -> m address value effects a
 resumingLoadError = runLoadErrorWith (\ baseError -> traceError "LoadError" baseError *> case baseErrorException baseError of
-  ModuleNotFoundError _ -> pure (lowerBound, hole))
+  ModuleNotFoundError _ -> pure (lowerBound, (lowerBound, hole)))
 
 resumingEvalError :: ( Applicative (m effects)
                      , Effectful m

src/Semantic/REPL.hs

@@ -104,6 +104,7 @@ repl proxy parser paths = defaultConfig debugOptions >>= \ config -> runM . runD
     . runReader (lowerBound @(ModuleTable (NonEmpty (Module (ModuleResult Precise)))))
     . raiseHandler (runModules (ModuleTable.modulePaths (packageModules (snd <$> package))))
     . runReader (packageInfo package)
+    . runState (lowerBound @Span)
     . runReader (lowerBound @Span)
     $ evaluate proxy id (withTermSpans . step (fmap (\ (x:|_) -> moduleBody x) <$> ModuleTable.toPairs (packageModules (fst <$> package)))) (Precise.runAllocator . Precise.runDeref) (Concrete.runBoolean . Concrete.runFunction coerce coerce) modules
 

src/Semantic/Util.hs

@@ -106,8 +106,9 @@ evaluateProject' (TaskConfig config logger statter) proxy parser paths = either
        (runReader (lowerBound @(ModuleTable (NonEmpty (Module (ModuleResult Precise)))))
        (raiseHandler (runModules (ModuleTable.modulePaths (packageModules package)))
        (runReader (packageInfo package)
+       (runState (lowerBound @Span)
        (runReader (lowerBound @Span)
-       (evaluate proxy id withTermSpans (Precise.runAllocator . Precise.runDeref) (Concrete.runBoolean . Concrete.runFunction coerce coerce) modules))))))
+       (evaluate proxy id withTermSpans (Precise.runAllocator . Precise.runDeref) (Concrete.runBoolean . Concrete.runFunction coerce coerce) modules)))))))
 
 evaluatePythonProjects proxy parser lang path = runTaskWithOptions debugOptions $ do
   project <- readProject Nothing path lang []
@@ -118,8 +119,9 @@ evaluatePythonProjects proxy parser lang path = runTaskWithOptions debugOptions
        (runReader (lowerBound @(ModuleTable (NonEmpty (Module (ModuleResult Precise)))))
        (raiseHandler (runModules (ModuleTable.modulePaths (packageModules package)))
        (runReader (packageInfo package)
+       (runState (lowerBound @Span)
        (runReader (lowerBound @Span)
-       (evaluate proxy id withTermSpans (Precise.runAllocator . Precise.runDeref) (Concrete.runBoolean . Concrete.runFunction coerce coerce) modules))))))
+       (evaluate proxy id withTermSpans (Precise.runAllocator . Precise.runDeref) (Concrete.runBoolean . Concrete.runFunction coerce coerce) modules)))))))
 
 
 evaluateProjectWithCaching proxy parser path = runTaskWithOptions debugOptions $ do
@@ -127,10 +129,11 @@ evaluateProjectWithCaching proxy parser path = runTaskWithOptions debugOptions $
   package <- fmap (quieterm . snd) <$> parsePackage parser project
   modules <- topologicalSort <$> runImportGraphToModules proxy package
   pure (runReader (packageInfo package)
+       (runState (lowerBound @Span)
        (runReader (lowerBound @Span)
        (runReader (lowerBound @(ModuleTable (NonEmpty (Module (ModuleResult Monovariant)))))
        (raiseHandler (runModules (ModuleTable.modulePaths (packageModules package)))
-       (evaluate proxy id withTermSpans (Monovariant.runAllocator . Monovariant.runDeref) (Type.runBoolean . Type.runFunction) modules)))))
+       (evaluate proxy id withTermSpans (Monovariant.runAllocator . Monovariant.runDeref) (Type.runBoolean . Type.runFunction) modules))))))
 
 
 parseFile :: Parser term -> FilePath -> IO term

test/Analysis/Go/Spec.hs

@@ -14,7 +14,7 @@ spec config = parallel $ do
     it "imports and wildcard imports" $ do
       (_, (heap, res)) <- evaluate ["main.go", "foo/foo.go", "bar/bar.go", "bar/rab.go"]
       case ModuleTable.lookup "main.go" <$> res of
-        Right (Just (Module _ (env, addr) :| [])) -> do
+        Right (Just (Module _ (_, (env, addr)) :| [])) -> do
           Env.names env `shouldBe` [ "Bar", "Rab", "foo", "main" ]
           (derefQName heap ("foo" :| []) env >>= deNamespace heap) `shouldBe` Just ("foo",  ["New"])
         other -> expectationFailure (show other)
@@ -22,7 +22,7 @@ spec config = parallel $ do
     it "imports with aliases (and side effects only)" $ do
       (_, (heap, res)) <- evaluate ["main1.go", "foo/foo.go", "bar/bar.go", "bar/rab.go"]
       case ModuleTable.lookup "main1.go" <$> res of
-        Right (Just (Module _ (env, addr) :| [])) -> do
+        Right (Just (Module _ (_, (env, addr)) :| [])) -> do
           Env.names env `shouldBe` [ "f", "main" ]
           (derefQName heap ("f" :| []) env >>= deNamespace heap) `shouldBe` Just ("f",  ["New"])
         other -> expectationFailure (show other)

test/Analysis/PHP/Spec.hs

@@ -15,7 +15,7 @@ spec config = parallel $ do
     it "evaluates include and require" $ do
       (_, (heap, res)) <- evaluate ["main.php", "foo.php", "bar.php"]
       case ModuleTable.lookup "main.php" <$> res of
-        Right (Just (Module _ (env, addr) :| [])) -> do
+        Right (Just (Module _ (_, (env, addr)) :| [])) -> do
           heapLookupAll addr heap `shouldBe` Just [unit]
           Env.names env `shouldBe` [ "bar", "foo" ]
         other -> expectationFailure (show other)
@@ -23,7 +23,7 @@ spec config = parallel $ do
     it "evaluates include_once and require_once" $ do
       (_, (heap, res)) <- evaluate ["main_once.php", "foo.php", "bar.php"]
       case ModuleTable.lookup "main_once.php" <$> res of
-        Right (Just (Module _ (env, addr) :| [])) -> do
+        Right (Just (Module _ (_, (env, addr)) :| [])) -> do
           heapLookupAll addr heap `shouldBe` Just [unit]
           Env.names env `shouldBe` [ "bar", "foo" ]
         other -> expectationFailure (show other)
@@ -31,7 +31,7 @@ spec config = parallel $ do
     it "evaluates namespaces" $ do
       (_, (heap, res)) <- evaluate ["namespaces.php"]
       case ModuleTable.lookup "namespaces.php" <$> res of
-        Right (Just (Module _ (env, addr) :| [])) -> do
+        Right (Just (Module _ (_, (env, addr)) :| [])) -> do
           Env.names env `shouldBe` [ "Foo", "NS1" ]
 
           (derefQName heap ("NS1" :| [])               env >>= deNamespace heap) `shouldBe` Just ("NS1",  ["Sub1", "b", "c"])

test/Analysis/Python/Spec.hs

@@ -16,7 +16,7 @@ spec config = parallel $ do
     it "imports" $ do
       (_, (heap, res)) <- evaluate ["main.py", "a.py", "b/__init__.py", "b/c.py"]
       case ModuleTable.lookup "main.py" <$> res of
-        Right (Just (Module _ (env, addr) :| [])) -> do
+        Right (Just (Module _ (_, (env, addr)) :| [])) -> do
           Env.names env `shouldContain` [ "a", "b" ]
 
           (derefQName heap ("a" :| [])    env >>= deNamespace heap) `shouldBe` Just ("a", ["foo"])
@@ -27,19 +27,19 @@ spec config = parallel $ do
     it "imports with aliases" $ do
       (_, (_, res)) <- evaluate ["main1.py", "a.py", "b/__init__.py", "b/c.py"]
       case ModuleTable.lookup "main1.py" <$> res of
-        Right (Just (Module _ (env, addr) :| [])) -> Env.names env `shouldContain` [ "b", "e" ]
+        Right (Just (Module _ (_, (env, addr)) :| [])) -> Env.names env `shouldContain` [ "b", "e" ]
         other -> expectationFailure (show other)
 
     it "imports using 'from' syntax" $ do
       (_, (_, res)) <- evaluate ["main2.py", "a.py", "b/__init__.py", "b/c.py"]
       case ModuleTable.lookup "main2.py" <$> res of
-        Right (Just (Module _ (env, addr) :| [])) -> Env.names env `shouldContain` [ "bar", "foo" ]
+        Right (Just (Module _ (_, (env, addr)) :| [])) -> Env.names env `shouldContain` [ "bar", "foo" ]
         other -> expectationFailure (show other)
 
     it "imports with relative syntax" $ do
       (_, (heap, res)) <- evaluate ["main3.py", "c/__init__.py", "c/utils.py"]
       case ModuleTable.lookup "main3.py" <$> res of
-        Right (Just (Module _ (env, addr) :| [])) -> do
+        Right (Just (Module _ (_, (env, addr)) :| [])) -> do
           Env.names env `shouldContain` [ "utils" ]
           (derefQName heap ("utils" :| []) env >>= deNamespace heap) `shouldBe` Just ("utils", ["to_s"])
         other -> expectationFailure (show other)
@@ -47,13 +47,13 @@ spec config = parallel $ do
     it "subclasses" $ do
       (_, (heap, res)) <- evaluate ["subclass.py"]
       case ModuleTable.lookup "subclass.py" <$> res of
-        Right (Just (Module _ (env, addr) :| [])) -> heapLookupAll addr heap `shouldBe` Just [String "\"bar\""]
+        Right (Just (Module _ (_, (env, addr)) :| [])) -> heapLookupAll addr heap `shouldBe` Just [String "\"bar\""]
         other -> expectationFailure (show other)
 
     it "handles multiple inheritance left-to-right" $ do
       (_, (heap, res)) <- evaluate ["multiple_inheritance.py"]
       case ModuleTable.lookup "multiple_inheritance.py" <$> res of
-        Right (Just (Module _ (env, addr) :| [])) -> heapLookupAll addr heap `shouldBe` Just [String "\"foo!\""]
+        Right (Just (Module _ (_, (env, addr)) :| [])) -> heapLookupAll addr heap `shouldBe` Just [String "\"foo!\""]
         other -> expectationFailure (show other)
 
   where

test/Analysis/Ruby/Spec.hs

@@ -21,7 +21,7 @@ spec config = parallel $ do
     it "evaluates require_relative" $ do
       (_, (heap, res)) <- evaluate ["main.rb", "foo.rb"]
       case ModuleTable.lookup "main.rb" <$> res of
-        Right (Just (Module _ (env, addr) :| [])) -> do
+        Right (Just (Module _ (_, (env, addr)) :| [])) -> do
           heapLookupAll addr heap `shouldBe` Just [Value.Integer (Number.Integer 1)]
           Env.names env `shouldContain` [ "foo" ]
         other -> expectationFailure (show other)
@@ -29,7 +29,7 @@ spec config = parallel $ do
     it "evaluates load" $ do
       (_, (heap, res)) <- evaluate ["load.rb", "foo.rb"]
       case ModuleTable.lookup "load.rb" <$> res of
-        Right (Just (Module _ (env, addr) :| [])) -> do
+        Right (Just (Module _ (_, (env, addr)) :| [])) -> do
           heapLookupAll addr heap `shouldBe` Just [Value.Integer (Number.Integer 1)]
           Env.names env `shouldContain` [ "foo" ]
         other -> expectationFailure (show other)
@@ -41,7 +41,7 @@ spec config = parallel $ do
     it "evaluates subclass" $ do
       (_, (heap, res)) <- evaluate ["subclass.rb"]
       case ModuleTable.lookup "subclass.rb" <$> res of
-        Right (Just (Module _ (env, addr) :| [])) -> do
+        Right (Just (Module _ (_, (env, addr)) :| [])) -> do
           heapLookupAll addr heap `shouldBe` Just [String "\"<bar>\""]
           Env.names env `shouldContain` [ "Bar", "Foo" ]
 
@@ -51,7 +51,7 @@ spec config = parallel $ do
     it "evaluates modules" $ do
       (_, (heap, res)) <- evaluate ["modules.rb"]
       case ModuleTable.lookup "modules.rb" <$> res of
-        Right (Just (Module _ (env, addr) :| [])) -> do
+        Right (Just (Module _ (_, (env, addr)) :| [])) -> do
           heapLookupAll addr heap `shouldBe` Just [String "\"<hello>\""]
           Env.names env `shouldContain` [ "Bar" ]
         other -> expectationFailure (show other)
@@ -59,43 +59,43 @@ spec config = parallel $ do
     it "handles break correctly" $ do
       (_, (heap, res)) <- evaluate ["break.rb"]
       case ModuleTable.lookup "break.rb" <$> res of
-        Right (Just (Module _ (env, addr) :| [])) -> heapLookupAll addr heap `shouldBe` Just [Value.Integer (Number.Integer 3)]
+        Right (Just (Module _ (_, (env, addr)) :| [])) -> heapLookupAll addr heap `shouldBe` Just [Value.Integer (Number.Integer 3)]
         other -> expectationFailure (show other)
 
     it "handles next correctly" $ do
       (_, (heap, res)) <- evaluate ["next.rb"]
       case ModuleTable.lookup "next.rb" <$> res of
-        Right (Just (Module _ (env, addr) :| [])) -> heapLookupAll addr heap `shouldBe` Just [Value.Integer (Number.Integer 8)]
+        Right (Just (Module _ (_, (env, addr)) :| [])) -> heapLookupAll addr heap `shouldBe` Just [Value.Integer (Number.Integer 8)]
         other -> expectationFailure (show other)
 
     it "calls functions with arguments" $ do
       (_, (heap, res)) <- evaluate ["call.rb"]
       case ModuleTable.lookup "call.rb" <$> res of
-        Right (Just (Module _ (env, addr) :| [])) -> heapLookupAll addr heap `shouldBe` Just [Value.Integer (Number.Integer 579)]
+        Right (Just (Module _ (_, (env, addr)) :| [])) -> heapLookupAll addr heap `shouldBe` Just [Value.Integer (Number.Integer 579)]
         other -> expectationFailure (show other)
 
     it "evaluates early return statements" $ do
       (_, (heap, res)) <- evaluate ["early-return.rb"]
       case ModuleTable.lookup "early-return.rb" <$> res of
-        Right (Just (Module _ (env, addr) :| [])) -> heapLookupAll addr heap `shouldBe` Just [Value.Integer (Number.Integer 123)]
+        Right (Just (Module _ (_, (env, addr)) :| [])) -> heapLookupAll addr heap `shouldBe` Just [Value.Integer (Number.Integer 123)]
         other -> expectationFailure (show other)
 
     it "has prelude" $ do
       (_, (heap, res)) <- evaluate ["preluded.rb"]
       case ModuleTable.lookup "preluded.rb" <$> res of
-        Right (Just (Module _ (env, addr) :| [])) -> heapLookupAll addr heap `shouldBe` Just [String "\"<foo>\""]
+        Right (Just (Module _ (_, (env, addr)) :| [])) -> heapLookupAll addr heap `shouldBe` Just [String "\"<foo>\""]
         other -> expectationFailure (show other)
 
     it "evaluates __LINE__" $ do
       (_, (heap, res)) <- evaluate ["line.rb"]
       case ModuleTable.lookup "line.rb" <$> res of
-        Right (Just (Module _ (env, addr) :| [])) -> heapLookupAll addr heap `shouldBe` Just [Value.Integer (Number.Integer 4)]
+        Right (Just (Module _ (_, (env, addr)) :| [])) -> heapLookupAll addr heap `shouldBe` Just [Value.Integer (Number.Integer 4)]
         other -> expectationFailure (show other)
 
     it "resolves builtins used in the prelude" $ do
       (traces, (heap, res)) <- evaluate ["puts.rb"]
       case ModuleTable.lookup "puts.rb" <$> res of
-        Right (Just (Module _ (env, addr) :| [])) -> do
+        Right (Just (Module _ (_, (env, addr)) :| [])) -> do
           heapLookupAll addr heap `shouldBe` Just [Unit]
           traces `shouldContain` [ "\"hello\"" ]
         other -> expectationFailure (show other)

test/Analysis/TypeScript/Spec.hs

@@ -17,13 +17,13 @@ spec config = parallel $ do
     it "imports with aliased symbols" $ do
       (_, (_, res)) <- evaluate ["main.ts", "foo.ts", "a.ts", "foo/b.ts"]
       case ModuleTable.lookup "main.ts" <$> res of
-        Right (Just (Module _ (env, _) :| [])) -> Env.names env `shouldBe` [ "bar", "quz" ]
+        Right (Just (Module _ (_, (env, _)) :| [])) -> Env.names env `shouldBe` [ "bar", "quz" ]
         other -> expectationFailure (show other)
 
     it "imports with qualified names" $ do
       (_, (heap, res)) <- evaluate ["main1.ts", "foo.ts", "a.ts"]
       case ModuleTable.lookup "main1.ts" <$> res of
-        Right (Just (Module _ (env, _) :| [])) -> do
+        Right (Just (Module _ (_, (env, _)) :| [])) -> do
           Env.names env `shouldBe` [ "b", "z" ]
 
           (derefQName heap ("b" :| []) env >>= deNamespace heap) `shouldBe` Just ("b", [ "baz", "foo" ])
@@ -33,7 +33,7 @@ spec config = parallel $ do
     it "side effect only imports" $ do
       (_, (_, res)) <- evaluate ["main2.ts", "a.ts", "foo.ts"]
       case ModuleTable.lookup "main2.ts" <$> res of
-        Right (Just (Module _ (env, _) :| [])) -> env `shouldBe` lowerBound
+        Right (Just (Module _ (_, (env, _)) :| [])) -> env `shouldBe` lowerBound
         other -> expectationFailure (show other)
 
     it "fails exporting symbols not defined in the module" $ do
@@ -43,13 +43,13 @@ spec config = parallel $ do
     it "evaluates early return statements" $ do
       (_, (heap, res)) <- evaluate ["early-return.ts"]
       case ModuleTable.lookup "early-return.ts" <$> res of
-        Right (Just (Module _ (_, addr) :| [])) -> heapLookupAll addr heap `shouldBe` Just [Value.Float (Number.Decimal 123.0)]
+        Right (Just (Module _ (_, (_, addr)) :| [])) -> heapLookupAll addr heap `shouldBe` Just [Value.Float (Number.Decimal 123.0)]
         other -> expectationFailure (show other)
 
     it "evaluates sequence expressions" $ do
       (_, (heap, res)) <- evaluate ["sequence-expression.ts"]
       case ModuleTable.lookup "sequence-expression.ts" <$> res of
-        Right (Just (Module _ (env, addr) :| [])) -> do
+        Right (Just (Module _ (_, (env, addr)) :| [])) -> do
           Env.names env `shouldBe` [ "x" ]
           (derefQName heap ("x" :| []) env) `shouldBe` Just (Value.Float (Number.Decimal 3.0))
         other -> expectationFailure (show other)
@@ -57,13 +57,13 @@ spec config = parallel $ do
     it "evaluates void expressions" $ do
       (_, (heap, res)) <- evaluate ["void.ts"]
       case ModuleTable.lookup "void.ts" <$> res of
-        Right (Just (Module _ (_, addr) :| [])) -> heapLookupAll addr heap `shouldBe` Just [Null]
+        Right (Just (Module _ (_, (_, addr)) :| [])) -> heapLookupAll addr heap `shouldBe` Just [Null]
         other -> expectationFailure (show other)
 
     it "evaluates delete" $ do
       (_, (heap, res)) <- evaluate ["delete.ts"]
       case ModuleTable.lookup "delete.ts" <$> res of
-        Right (Just (Module _ (env, addr) :| [])) -> do
+        Right (Just (Module _ (_, (env, addr)) :| [])) -> do
           heapLookupAll addr heap `shouldBe` Just [Unit]
           (derefQName heap ("x" :| []) env) `shouldBe` Nothing
           Env.names env `shouldBe` [ "x" ]
@@ -72,7 +72,7 @@ spec config = parallel $ do
     it "evaluates await" $ do
       (_, (heap, res)) <- evaluate ["await.ts"]
       case ModuleTable.lookup "await.ts" <$> res of
-        Right (Just (Module _ (env, addr) :| [])) -> do
+        Right (Just (Module _ (_, (env, addr)) :| [])) -> do
           Env.names env `shouldBe` [ "f2" ]
           (derefQName heap ("y" :| []) env) `shouldBe` Nothing
         other -> expectationFailure (show other)
@@ -80,41 +80,41 @@ spec config = parallel $ do
     it "evaluates BOr statements" $ do
       (_, (heap, res)) <- evaluate ["bor.ts"]
       case ModuleTable.lookup "bor.ts" <$> res of
-        Right (Just (Module _ (_, addr) :| [])) -> heapLookupAll addr heap `shouldBe` Just [Value.Integer (Number.Integer 3)]
+        Right (Just (Module _ (_, (_, addr)) :| [])) -> heapLookupAll addr heap `shouldBe` Just [Value.Integer (Number.Integer 3)]
         other -> expectationFailure (show other)
 
     it "evaluates BAnd statements" $ do
       (_, (heap, res)) <- evaluate ["band.ts"]
       case ModuleTable.lookup "band.ts" <$> res of
-        Right (Just (Module _ (_, addr) :| [])) -> heapLookupAll addr heap `shouldBe` Just [Value.Integer (Number.Integer 0)]
+        Right (Just (Module _ (_, (_, addr)) :| [])) -> heapLookupAll addr heap `shouldBe` Just [Value.Integer (Number.Integer 0)]
         other -> expectationFailure (show other)
 
     it "evaluates BXOr statements" $ do
       (_, (heap, res)) <- evaluate ["bxor.ts"]
       case ModuleTable.lookup "bxor.ts" <$> res of
-        Right (Just (Module _ (_, addr) :| [])) -> heapLookupAll addr heap `shouldBe` Just [Value.Integer (Number.Integer 3)]
+        Right (Just (Module _ (_, (_, addr)) :| [])) -> heapLookupAll addr heap `shouldBe` Just [Value.Integer (Number.Integer 3)]
         other -> expectationFailure (show other)
 
     it "evaluates LShift statements" $ do
       (_, (heap, res)) <- evaluate ["lshift.ts"]
       case ModuleTable.lookup "lshift.ts" <$> res of
-        Right (Just (Module _ (_, addr) :| [])) -> heapLookupAll addr heap `shouldBe` Just [Value.Integer (Number.Integer 4)]
+        Right (Just (Module _ (_, (_, addr)) :| [])) -> heapLookupAll addr heap `shouldBe` Just [Value.Integer (Number.Integer 4)]
         other -> expectationFailure (show other)
 
     it "evaluates RShift statements" $ do
       (_, (heap, res)) <- evaluate ["rshift.ts"]
       case ModuleTable.lookup "rshift.ts" <$> res of
-        Right (Just (Module _ (_, addr) :| [])) -> heapLookupAll addr heap `shouldBe` Just [Value.Integer (Number.Integer 0)]
+        Right (Just (Module _ (_, (_, addr)) :| [])) -> heapLookupAll addr heap `shouldBe` Just [Value.Integer (Number.Integer 0)]
         other -> expectationFailure (show other)
 
     it "evaluates Complement statements" $ do
       (_, (heap, res)) <- evaluate ["complement.ts"]
       case ModuleTable.lookup "complement.ts" <$> res of
-        Right (Just (Module _ (_, addr) :| [])) -> heapLookupAll addr heap `shouldBe` Just [Value.Integer (Number.Integer (-2))]
+        Right (Just (Module _ (_, (_, addr)) :| [])) -> heapLookupAll addr heap `shouldBe` Just [Value.Integer (Number.Integer (-2))]
         other -> expectationFailure (show other)
 
 
   where
     fixtures = "test/fixtures/typescript/analysis/"
     evaluate = evalTypeScriptProject . map (fixtures <>)
-    evalTypeScriptProject = testEvaluating <=< evaluateProject' config (Proxy :: Proxy 'Language.TypeScript) typescriptParser
+    evalTypeScriptProject = testEvaluating <=< (evaluateProject' config (Proxy :: Proxy 'Language.TypeScript) typescriptParser)

test/SpecHelpers.hs

@@ -118,12 +118,12 @@ type TestEvaluatingErrors = '[ BaseError (ValueError Precise (ConcreteEff Precis
                              , BaseError (UnspecializedError Val)
                              , BaseError (LoadError Precise)
                              ]
-testEvaluating :: Evaluator Precise Val TestEvaluatingEffects (ModuleTable (NonEmpty (Module (ModuleResult Precise))))
+testEvaluating :: Evaluator Precise Val TestEvaluatingEffects (Span, a)
                -> IO
                  ( [String]
                  , ( Heap Precise Val
                    , Either (SomeExc (Data.Sum.Sum TestEvaluatingErrors))
-                            (ModuleTable (NonEmpty (Module (ModuleResult Precise))))
+                            a
                    )
                  )
 testEvaluating
@@ -139,6 +139,7 @@ testEvaluating
   . runResolutionError
   . runAddressError
   . runValueError @_ @Precise @(ConcreteEff Precise _)
+  . fmap snd
 
 type Val = Value Precise (ConcreteEff Precise '[Trace, Lift IO])
 
@@ -153,11 +154,12 @@ namespaceScope :: Heap Precise (Value Precise term)
                -> Value Precise term
                -> Maybe (Environment Precise)
 namespaceScope heap ns@(Namespace _ _ _)
-  = either (const Nothing) snd
+  = either (const Nothing) (snd . snd)
   . run
   . runFresh 0
   . runAddressError
   . runState heap
+  . runState (lowerBound @Span)
   . runReader (lowerBound @Span)
   . runReader (ModuleInfo "SpecHelper.hs")
   . runDeref