Merge remote-tracking branch 'origin/master' into enhanced-json-output

src/Analysis/Abstract/Caching.hs

@@ -60,7 +60,7 @@ cachingTerms :: ( Cacheable term location (Cell location) value
                 , Corecursive term
                 , Member NonDet effects
                 , Member (Reader (Cache term location (Cell location) value)) effects
-                , Member (Reader (Live location value)) effects
+                , Member (Reader (Live location)) effects
                 , Member (State (Cache term location (Cell location) value)) effects
                 , Member (State (Environment location)) effects
                 , Member (State (Heap location (Cell location) value)) effects
@@ -83,7 +83,7 @@ convergingModules :: ( AbstractValue location value effects
                      , Member NonDet effects
                      , Member (Reader (Cache term location (Cell location) value)) effects
                      , Member (Reader (Environment location)) effects
-                     , Member (Reader (Live location value)) effects
+                     , Member (Reader (Live location)) effects
                      , Member (Resumable (EnvironmentError location)) effects
                      , Member (State (Cache term location (Cell location) value)) effects
                      , Member (State (Environment location)) effects

src/Analysis/Abstract/Collecting.hs

@@ -12,7 +12,7 @@ import Prologue
 
 -- | An analysis performing GC after every instruction.
 collectingTerms :: ( Foldable (Cell location)
-                   , Member (Reader (Live location value)) effects
+                   , Member (Reader (Live location)) effects
                    , Member (State (Heap location (Cell location) value)) effects
                    , Ord location
                    , ValueRoots location value
@@ -29,7 +29,7 @@ gc :: ( Ord location
       , Foldable (Cell location)
       , ValueRoots location value
       )
-   => Live location value                 -- ^ The set of addresses to consider rooted.
+   => Live location                       -- ^ The set of addresses to consider rooted.
    -> Heap location (Cell location) value -- ^ A heap to collect unreachable addresses within.
    -> Heap location (Cell location) value -- ^ A garbage-collected heap.
 gc roots heap = heapRestrict heap (reachable roots heap)
@@ -39,9 +39,9 @@ reachable :: ( Ord location
              , Foldable (Cell location)
              , ValueRoots location value
              )
-          => Live location value                 -- ^ The set of root addresses.
+          => Live location                       -- ^ The set of root addresses.
           -> Heap location (Cell location) value -- ^ The heap to trace addresses through.
-          -> Live location value                 -- ^ The set of addresses reachable from the root set.
+          -> Live location                       -- ^ The set of addresses reachable from the root set.
 reachable roots heap = go mempty roots
   where go seen set = case liveSplit set of
           Nothing -> seen
@@ -50,5 +50,5 @@ reachable roots heap = go mempty roots
             _           -> seen)
 
 
-providingLiveSet :: Effectful (m location value) => m location value (Reader (Live location value) ': effects) a -> m location value effects a
+providingLiveSet :: Effectful (m location value) => m location value (Reader (Live location) ': effects) a -> m location value effects a
 providingLiveSet = runReader lowerBound

src/Analysis/Abstract/Graph.hs

@@ -128,7 +128,7 @@ variableDefinition :: ( Member (Reader (Environment (Hole (Located location))))
                    => Name
                    -> TermEvaluator term (Hole (Located location)) value effects ()
 variableDefinition name = do
-  graph <- maybe lowerBound (maybe lowerBound (vertex . moduleVertex . locationModule) . toMaybe . unAddress) <$> TermEvaluator (lookupEnv name)
+  graph <- maybe lowerBound (maybe lowerBound (vertex . moduleVertex . locationModule) . toMaybe) <$> TermEvaluator (lookupEnv name)
   appendGraph (vertex (Variable (unName name)) `connect` graph)
 
 appendGraph :: (Effectful m, Member (State (Graph Vertex)) effects) => Graph Vertex -> m effects ()

src/Analysis/Abstract/Tracing.hs

@@ -13,7 +13,7 @@ import Prologue
 --
 --   Instantiating @trace@ to @[]@ yields a linear trace analysis, while @Set@ yields a reachable state analysis.
 tracingTerms :: ( Corecursive term
-                , Member (Reader (Live location value)) effects
+                , Member (Reader (Live location)) effects
                 , Member (State (Environment location)) effects
                 , Member (State (Heap location (Cell location) value)) effects
                 , Member (Writer (trace (Configuration term location (Cell location) value))) effects

src/Control/Abstract/Addressable.hs

@@ -10,23 +10,23 @@ import Data.Abstract.Address
 import Data.Abstract.Name
 import Prologue
 
--- | Defines allocation and dereferencing of 'Address'es in a 'Heap'.
+-- | Defines allocation and dereferencing of addresses.
 class (Ord location, Show location) => Addressable location effects where
   -- | The type into which stored values will be written for a given location type.
   type family Cell location :: * -> *
 
   allocCell :: Name -> Evaluator location value effects location
-  derefCell :: Address location value -> Cell location value -> Evaluator location value effects (Maybe value)
+  derefCell :: location -> Cell location value -> Evaluator location value effects (Maybe value)
 
 
--- | 'Precise' locations are always allocated a fresh 'Address', and dereference to the 'Latest' value written.
+-- | 'Precise' locations are always allocated a fresh address, and dereference to the 'Latest' value written.
 instance Member Fresh effects => Addressable Precise effects where
   type Cell Precise = Latest
 
   allocCell _ = Precise <$> fresh
   derefCell _ = pure . getLast . unLatest
 
--- | 'Monovariant' locations allocate one 'Address' per unique variable name, and dereference once per stored value, nondeterministically.
+-- | 'Monovariant' locations allocate one address per unique variable name, and dereference once per stored value, nondeterministically.
 instance Member NonDet effects => Addressable Monovariant effects where
   type Cell Monovariant = All
 
@@ -38,14 +38,14 @@ instance (Addressable location effects, Member (Reader ModuleInfo) effects, Memb
   type Cell (Located location) = Cell location
 
   allocCell name = relocate (Located <$> allocCell name <*> currentPackage <*> currentModule)
-  derefCell (Address (Located loc _ _)) = relocate . derefCell (Address loc)
+  derefCell (Located loc _ _) = relocate . derefCell loc
 
 instance Addressable location effects => Addressable (Hole location) effects where
   type Cell (Hole location) = Cell location
 
   allocCell name = relocate (Total <$> allocCell name)
-  derefCell (Address (Total loc)) = relocate . derefCell (Address loc)
-  derefCell (Address Partial)     = const (pure Nothing)
+  derefCell (Total loc) = relocate . derefCell loc
+  derefCell Partial     = const (pure Nothing)
 
 relocate :: Evaluator location1 value effects a -> Evaluator location2 value effects a
 relocate = raiseEff . lowerEff

src/Control/Abstract/Configuration.hs

@@ -12,5 +12,5 @@ import Control.Abstract.TermEvaluator
 import Data.Abstract.Configuration
 
 -- | Get the current 'Configuration' with a passed-in term.
-getConfiguration :: (Member (Reader (Live location value)) effects, Member (State (Environment location)) effects, Member (State (Heap location (Cell location) value)) effects) => term -> TermEvaluator term location value effects (Configuration term location (Cell location) value)
+getConfiguration :: (Member (Reader (Live location)) effects, Member (State (Environment location)) effects, Member (State (Heap location (Cell location) value)) effects) => term -> TermEvaluator term location value effects (Configuration term location (Cell location) value)
 getConfiguration term = Configuration term <$> TermEvaluator askRoots <*> TermEvaluator getEnv <*> TermEvaluator getHeap

src/Control/Abstract/Environment.hs

@@ -3,14 +3,12 @@ module Control.Abstract.Environment
 ( Environment
 , getEnv
 , putEnv
-, modifyEnv
 , withEnv
-, defaultEnvironment
 , withDefaultEnvironment
-, fullEnvironment
-, localEnv
-, localize
 , lookupEnv
+, bind
+, bindAll
+, locally
 , EnvironmentError(..)
 , freeVariableError
 , runEnvironmentError
@@ -18,7 +16,6 @@ module Control.Abstract.Environment
 ) where
 
 import Control.Abstract.Evaluator
-import Data.Abstract.Address
 import Data.Abstract.Environment as Env
 import Data.Abstract.Name
 import Prologue
@@ -49,26 +46,25 @@ defaultEnvironment = ask
 withDefaultEnvironment :: Member (Reader (Environment location)) effects => Environment location -> Evaluator location value effects a -> Evaluator location value effects a
 withDefaultEnvironment e = local (const e)
 
--- | Obtain an environment that is the composition of the current and default environments.
---   Useful for debugging.
-fullEnvironment :: (Member (Reader (Environment location)) effects, Member (State (Environment location)) effects) => Evaluator location value effects (Environment location)
-fullEnvironment = mergeEnvs <$> getEnv <*> defaultEnvironment
-
--- | Run an action with a locally-modified environment.
-localEnv :: Member (State (Environment location)) effects => (Environment location -> Environment location) -> Evaluator location value effects a -> Evaluator location value effects a
-localEnv f a = do
-  modifyEnv (f . Env.push)
-  result <- a
-  result <$ modifyEnv Env.pop
-
--- | Run a computation in a new local environment.
-localize :: Member (State (Environment location)) effects => Evaluator location value effects a -> Evaluator location value effects a
-localize = localEnv id
-
 -- | Look a 'Name' up in the current environment, trying the default environment if no value is found.
-lookupEnv :: (Member (Reader (Environment location)) effects, Member (State (Environment location)) effects) => Name -> Evaluator location value effects (Maybe (Address location value))
+lookupEnv :: (Member (Reader (Environment location)) effects, Member (State (Environment location)) effects) => Name -> Evaluator location value effects (Maybe location)
 lookupEnv name = (<|>) <$> (Env.lookup name <$> getEnv) <*> (Env.lookup name <$> defaultEnvironment)
 
+-- | Bind a 'Name' to an 'Address' in the current scope.
+bind :: Member (State (Environment location)) effects => Name -> location -> Evaluator location value effects ()
+bind name = modifyEnv . Env.insert name
+
+-- | Bind all of the names from an 'Environment' in the current scope.
+bindAll :: Member (State (Environment location)) effects => Environment location -> Evaluator location value effects ()
+bindAll = foldr ((>>) . uncurry bind) (pure ()) . pairs
+
+-- | Run an action in a new local environment.
+locally :: Member (State (Environment location)) effects => Evaluator location value effects a -> Evaluator location value effects a
+locally a = do
+  modifyEnv Env.push
+  a' <- a
+  a' <$ modifyEnv Env.pop
+
 
 -- | Errors involving the environment.
 data EnvironmentError location return where

src/Control/Abstract/Exports.hs

@@ -8,7 +8,6 @@ module Control.Abstract.Exports
 ) where
 
 import Control.Abstract.Evaluator
-import Data.Abstract.Address
 import Data.Abstract.Exports
 import Data.Abstract.Name
 
@@ -25,7 +24,7 @@ modifyExports :: Member (State (Exports location)) effects => (Exports location
 modifyExports = modify'
 
 -- | Add an export to the global export state.
-addExport :: Member (State (Exports location)) effects => Name -> Name -> Maybe (Address location value) -> Evaluator location value effects ()
+addExport :: Member (State (Exports location)) effects => Name -> Name -> Maybe location -> Evaluator location value effects ()
 addExport name alias = modifyExports . insert name alias
 
 -- | Sets the global export state for the lifetime of the given action.

src/Control/Abstract/Heap.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE GADTs, RankNTypes, TypeFamilies, TypeOperators, UndecidableInstances #-}
+{-# LANGUAGE GADTs, RankNTypes, ScopedTypeVariables, TypeFamilies, TypeOperators, UndecidableInstances #-}
 module Control.Abstract.Heap
 ( Heap
 , getHeap
@@ -23,8 +23,6 @@ import Control.Abstract.Addressable
 import Control.Abstract.Environment
 import Control.Abstract.Evaluator
 import Control.Monad.Effect.Internal
-import Data.Abstract.Address
-import Data.Abstract.Environment
 import Data.Abstract.Heap
 import Data.Abstract.Name
 import Data.Semigroup.Reducer
@@ -43,20 +41,20 @@ modifyHeap :: Member (State (Heap location (Cell location) value)) effects => (H
 modifyHeap = modify'
 
 
-alloc :: Member (Allocator location value) effects => Name -> Evaluator location value effects (Address location value)
-alloc = send . Alloc
+alloc :: forall location value effects . Member (Allocator location value) effects => Name -> Evaluator location value effects location
+alloc = send . Alloc @location @value
 
--- | Dereference the given 'Address'in the heap, or fail if the address is uninitialized.
-deref :: Member (Allocator location value) effects => Address location value -> Evaluator location value effects value
+-- | Dereference the given address in the heap, or fail if the address is uninitialized.
+deref :: Member (Allocator location value) effects => location -> Evaluator location value effects value
 deref = send . Deref
 
 
--- | Write a value to the given 'Address' in the 'Store'.
+-- | Write a value to the given address in the 'Store'.
 assign :: ( Member (State (Heap location (Cell location) value)) effects
           , Ord location
           , Reducer value (Cell location value)
           )
-       => Address location value
+       => location
        -> value
        -> Evaluator location value effects ()
 assign address = modifyHeap . heapInsert address
@@ -68,7 +66,7 @@ lookupOrAlloc :: ( Member (Allocator location value) effects
                  , Member (State (Environment location)) effects
                  )
               => Name
-              -> Evaluator location value effects (Address location value)
+              -> Evaluator location value effects location
 lookupOrAlloc name = lookupEnv name >>= maybe (alloc name) pure
 
 
@@ -81,10 +79,10 @@ letrec :: ( Member (Allocator location value) effects
           )
        => Name
        -> Evaluator location value effects value
-       -> Evaluator location value effects (value, Address location value)
+       -> Evaluator location value effects (value, location)
 letrec name body = do
   addr <- lookupOrAlloc name
-  v <- localEnv (insert name addr) body
+  v <- locally (bind name addr *> body)
   assign addr v
   pure (v, addr)
 
@@ -94,12 +92,12 @@ letrec' :: ( Member (Allocator location value) effects
            , Member (State (Environment location)) effects
            )
         => Name
-        -> (Address location value -> Evaluator location value effects value)
+        -> (location -> Evaluator location value effects value)
         -> Evaluator location value effects value
 letrec' name body = do
   addr <- lookupOrAlloc name
-  v <- localEnv id (body addr)
-  v <$ modifyEnv (insert name addr)
+  v <- locally (body addr)
+  v <$ bind name addr
 
 
 -- | Look up and dereference the given 'Name', throwing an exception for free variables.
@@ -110,24 +108,24 @@ variable :: ( Member (Allocator location value) effects
             )
          => Name
          -> Evaluator location value effects value
-variable name = lookupEnv name >>= maybeM (Address <$> freeVariableError name) >>= deref
+variable name = lookupEnv name >>= maybeM (freeVariableError name) >>= deref
 
 
 -- Effects
 
 data Allocator location value return where
-  Alloc :: Name                   -> Allocator location value (Address location value)
-  Deref :: Address location value -> Allocator location value value
+  Alloc :: Name     -> Allocator location value location
+  Deref :: location -> Allocator location value value
 
 runAllocator :: (Addressable location effects, Effectful (m location value), Member (Resumable (AddressError location value)) effects, Member (State (Heap location (Cell location) value)) effects) => m location value (Allocator location value ': effects) a -> m location value effects a
 runAllocator = raiseHandler (interpret (\ eff -> case eff of
-  Alloc name -> lowerEff $ Address <$> allocCell name
+  Alloc name -> lowerEff $ allocCell name
   Deref addr -> lowerEff $ heapLookup addr <$> get >>= maybeM (throwResumable (UnallocatedAddress addr)) >>= derefCell addr >>= maybeM (throwResumable (UninitializedAddress addr))))
 
 
 data AddressError location value resume where
-  UnallocatedAddress   :: Address location value -> AddressError location value (Cell location value)
-  UninitializedAddress :: Address location value -> AddressError location value value
+  UnallocatedAddress   :: location -> AddressError location value (Cell location value)
+  UninitializedAddress :: location -> AddressError location value value
 
 deriving instance Eq location => Eq (AddressError location value resume)
 deriving instance Show location => Show (AddressError location value resume)

src/Control/Abstract/Primitive.hs

@@ -6,7 +6,6 @@ import Control.Abstract.Environment
 import Control.Abstract.Evaluator
 import Control.Abstract.Heap
 import Control.Abstract.Value
-import Data.Abstract.Environment
 import Data.Abstract.Name
 import Data.ByteString.Char8 (pack, unpack)
 import Data.Semigroup.Reducer hiding (unit)
@@ -28,7 +27,7 @@ builtin :: ( HasCallStack
 builtin s def = withCurrentCallStack callStack $ do
   let name' = name (pack ("__semantic_" <> s))
   addr <- alloc name'
-  modifyEnv (insert name' addr)
+  bind name' addr
   def >>= assign addr
 
 lambda :: (AbstractFunction location value effects, Member Fresh effects)

src/Control/Abstract/Roots.hs

@@ -9,9 +9,9 @@ import Data.Abstract.Live
 import Prologue
 
 -- | Retrieve the local 'Live' set.
-askRoots :: Member (Reader (Live location value)) effects => Evaluator location value effects (Live location value)
+askRoots :: Member (Reader (Live location)) effects => Evaluator location value effects (Live location)
 askRoots = ask
 
 -- | Run a computation with the given 'Live' set added to the local root set.
-extraRoots :: (Member (Reader (Live location value)) effects, Ord location) => Live location value -> Evaluator location value effects a -> Evaluator location value effects a
+extraRoots :: (Member (Reader (Live location)) effects, Ord location) => Live location -> Evaluator location value effects a -> Evaluator location value effects a
 extraRoots roots = local (<> roots)

src/Control/Abstract/Value.hs

@@ -19,7 +19,6 @@ import Control.Abstract.Addressable
 import Control.Abstract.Environment
 import Control.Abstract.Evaluator
 import Control.Abstract.Heap
-import Data.Abstract.Address (Address)
 import Data.Abstract.Environment as Env
 import Data.Abstract.Live (Live)
 import Data.Abstract.Name
@@ -167,7 +166,7 @@ forLoop :: ( AbstractValue location value effects
         -> Evaluator location value effects value -- ^ Body
         -> Evaluator location value effects value
 forLoop initial cond step body =
-  localize (initial *> while cond (body *> step))
+  locally (initial *> while cond (body *> step))
 
 -- | The fundamental looping primitive, built on top of 'ifthenelse'.
 while :: AbstractValue location value effects
@@ -194,7 +193,7 @@ makeNamespace :: ( AbstractValue location value effects
                  , Reducer value (Cell location value)
                  )
               => Name
-              -> Address location value
+              -> location
               -> Maybe value
               -> Evaluator location value effects value
 makeNamespace name addr super = do
@@ -214,7 +213,7 @@ evaluateInScopedEnv :: ( AbstractValue location value effects
                     -> Evaluator location value effects value
 evaluateInScopedEnv scopedEnvTerm term = do
   scopedEnv <- scopedEnvTerm >>= scopedEnvironment
-  maybe term (flip localEnv term . mergeEnvs) scopedEnv
+  maybe term (\ env -> locally (bindAll env *> term)) scopedEnv
 
 
 -- | Evaluates a 'Value' returning the referenced value
@@ -245,4 +244,4 @@ subtermValue = value <=< subtermRef
 -- | Value types, e.g. closures, which can root a set of addresses.
 class ValueRoots location value where
   -- | Compute the set of addresses rooted by a given value.
-  valueRoots :: value -> Live location value
+  valueRoots :: value -> Live location

src/Data/Abstract/Address.hs

@@ -10,18 +10,6 @@ import Data.Semilattice.Lower
 import Data.Set as Set
 import Prologue
 
--- | An abstract address with a @location@ pointing to a variable of type @value@.
-newtype Address location value = Address { unAddress :: location }
-  deriving (Eq, Ord)
-
-instance Eq   location => Eq1   (Address location) where liftEq          _ a b = unAddress a    ==     unAddress b
-instance Ord  location => Ord1  (Address location) where liftCompare     _ a b = unAddress a `compare` unAddress b
-instance Show location => Show1 (Address location) where liftShowsPrec _ _     = showsPrec
-
-instance Show location => Show (Address location value) where
-  showsPrec d = showsPrec d . unAddress
-
-
 -- | 'Precise' models precise store semantics where only the 'Latest' value is taken. Everything gets it's own address (always makes a new allocation) which makes for a larger store.
 newtype Precise = Precise { unPrecise :: Int }
   deriving (Eq, Ord)

src/Data/Abstract/Configuration.hs

@@ -7,7 +7,7 @@ import Data.Abstract.Live
 -- | A single point in a program’s execution.
 data Configuration term location cell value = Configuration
   { configurationTerm        :: term                     -- ^ The “instruction,” i.e. the current term to evaluate.
-  , configurationRoots       :: Live location value      -- ^ The set of rooted addresses.
+  , configurationRoots       :: Live location            -- ^ The set of rooted addresses.
   , configurationEnvironment :: Environment location     -- ^ The environment binding any free variables in 'configurationTerm'.
   , configurationHeap        :: Heap location cell value -- ^ The heap of values.
   }

src/Data/Abstract/Environment.hs

@@ -1,7 +1,7 @@
 module Data.Abstract.Environment
   ( Environment(..)
   , addresses
-  , bind
+  , intersect
   , delete
   , head
   , emptyEnv
@@ -18,7 +18,6 @@ module Data.Abstract.Environment
   , roots
   ) where
 
-import           Data.Abstract.Address
 import           Data.Abstract.Live
 import           Data.Abstract.Name
 import           Data.Align
@@ -29,8 +28,9 @@ import           Prelude hiding (head, lookup)
 import           Prologue
 
 -- $setup
--- >>> let bright = push (insert (name "foo") (Address (Precise 0)) emptyEnv)
--- >>> let shadowed = insert (name "foo") (Address (Precise 1)) bright
+-- >>> import Data.Abstract.Address
+-- >>> let bright = push (insert (name "foo") (Precise 0) emptyEnv)
+-- >>> let shadowed = insert (name "foo") (Precise 1) bright
 
 -- | A LIFO stack of maps of names to addresses, representing a lexically-scoped evaluation environment.
 --   All behaviors can be assumed to be frontmost-biased: looking up "a" will check the most specific
@@ -72,22 +72,22 @@ mergeNewer (Environment a) (Environment b) =
 --
 -- >>> pairs shadowed
 -- [("foo",Precise 1)]
-pairs :: Environment location -> [(Name, Address location value)]
-pairs = map (second Address) . Map.toList . fold . unEnvironment
+pairs :: Environment location -> [(Name, location)]
+pairs = Map.toList . fold . unEnvironment
 
-unpairs :: [(Name, Address location value)] -> Environment location
-unpairs = Environment . pure . Map.fromList . map (second unAddress)
+unpairs :: [(Name, location)] -> Environment location
+unpairs = Environment . pure . Map.fromList
 
 -- | Lookup a 'Name' in the environment.
 --
 -- >>> lookup (name "foo") shadowed
 -- Just (Precise 1)
-lookup :: Name -> Environment location -> Maybe (Address location value)
-lookup k = fmap Address . foldMapA (Map.lookup k) . unEnvironment
+lookup :: Name -> Environment location -> Maybe location
+lookup name = foldMapA (Map.lookup name) . unEnvironment
 
 -- | Insert a 'Name' in the environment.
-insert :: Name -> Address location value -> Environment location -> Environment location
-insert name (Address value) (Environment (a :| as)) = Environment (Map.insert name value a :| as)
+insert :: Name -> location -> Environment location -> Environment location
+insert name addr (Environment (a :| as)) = Environment (Map.insert name addr a :| as)
 
 -- | Remove a 'Name' from the environment.
 --
@@ -100,8 +100,8 @@ trim :: Environment location -> Environment location
 trim (Environment (a :| as)) = Environment (a :| filtered)
   where filtered = filter (not . Map.null) as
 
-bind :: Foldable t => t Name -> Environment location -> Environment location
-bind names env = unpairs (mapMaybe lookupName (toList names))
+intersect :: Foldable t => t Name -> Environment location -> Environment location
+intersect names env = unpairs (mapMaybe lookupName (toList names))
   where
     lookupName name = (,) name <$> lookup name env
 
@@ -118,10 +118,10 @@ overwrite pairs env = unpairs $ mapMaybe lookupAndAlias pairs
 -- | Retrieve the 'Live' set of addresses to which the given free variable names are bound.
 --
 --   Unbound names are silently dropped.
-roots :: (Ord location, Foldable t) => Environment location -> t Name -> Live location value
-roots env = foldMap (maybe mempty liveSingleton . flip lookup env)
+roots :: (Ord location, Foldable t) => Environment location -> t Name -> Live location
+roots env names = addresses (names `intersect` env)
 
-addresses :: Ord location => Environment location -> Live location value
+addresses :: Ord location => Environment location -> Live location
 addresses = fromAddresses . map snd . pairs
 
 

src/Data/Abstract/Exports.hs

@@ -7,13 +7,12 @@ module Data.Abstract.Exports
     , toEnvironment
     ) where
 
-import Prelude hiding (null)
-import Prologue hiding (null)
-import Data.Abstract.Address
 import Data.Abstract.Environment (Environment, unpairs)
 import Data.Abstract.Name
 import qualified Data.Map as Map
 import Data.Semilattice.Lower
+import Prelude hiding (null)
+import Prologue hiding (null)
 
 -- | A map of export names to an alias & address tuple.
 newtype Exports location = Exports { unExports :: Map.Map Name (Name, Maybe location) }
@@ -23,10 +22,10 @@ null :: Exports location -> Bool
 null = Map.null . unExports
 
 toEnvironment :: Exports location -> Environment location
-toEnvironment exports = unpairs (mapMaybe (traverse (fmap Address)) (toList (unExports exports)))
+toEnvironment exports = unpairs (mapMaybe sequenceA (toList (unExports exports)))
 
-insert :: Name -> Name -> Maybe (Address location value) -> Exports location -> Exports location
-insert name alias address = Exports . Map.insert name (alias, unAddress <$> address) . unExports
+insert :: Name -> Name -> Maybe location -> Exports location -> Exports location
+insert name alias address = Exports . Map.insert name (alias, address) . unExports
 
 -- TODO: Should we filter for duplicates here?
 aliases :: Exports location -> [(Name, Name)]

src/Data/Abstract/Heap.hs

@@ -1,7 +1,6 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 module Data.Abstract.Heap where
 
-import Data.Abstract.Address
 import Data.Abstract.Live
 import qualified Data.Map.Monoidal as Monoidal
 import Data.Semigroup.Reducer
@@ -13,34 +12,34 @@ newtype Heap location cell value = Heap { unHeap :: Monoidal.Map location (cell
   deriving (Eq, Foldable, Functor, Lower, Monoid, Ord, Semigroup, Traversable)
 
 -- | Look up the cell of values for an 'Address' in a 'Heap', if any.
-heapLookup :: Ord location => Address location value -> Heap location cell value -> Maybe (cell value)
-heapLookup (Address address) = Monoidal.lookup address . unHeap
+heapLookup :: Ord location => location -> Heap location cell value -> Maybe (cell value)
+heapLookup address = Monoidal.lookup address . unHeap
 
 -- | Look up the list of values stored for a given address, if any.
-heapLookupAll :: (Ord location, Foldable cell) => Address location value -> Heap location cell value -> Maybe [value]
+heapLookupAll :: (Ord location, Foldable cell) => location -> Heap location cell value -> Maybe [value]
 heapLookupAll address = fmap toList . heapLookup address
 
 -- | Append a value onto the cell for a given address, inserting a new cell if none existed.
-heapInsert :: (Ord location, Reducer value (cell value)) => Address location value -> value -> Heap location cell value -> Heap location cell value
+heapInsert :: (Ord location, Reducer value (cell value)) => location -> value -> Heap location cell value -> Heap location cell value
 heapInsert address value = flip snoc (address, value)
 
 -- | Manually insert a cell into the heap at a given address.
-heapInit :: Ord location => Address location value -> cell value -> Heap location cell value -> Heap location cell value
-heapInit (Address address) cell (Heap h) = Heap (Monoidal.insert address cell h)
+heapInit :: Ord location => location -> cell value -> Heap location cell value -> Heap location cell value
+heapInit address cell (Heap h) = Heap (Monoidal.insert address cell h)
 
 -- | The number of addresses extant in a 'Heap'.
 heapSize :: Heap location cell value -> Int
 heapSize = Monoidal.size . unHeap
 
--- | Restrict a 'Heap' to only those 'Address'es in the given 'Live' set (in essence garbage collecting the rest).
-heapRestrict :: Ord location => Heap location cell value -> Live location value -> Heap location cell value
-heapRestrict (Heap m) roots = Heap (Monoidal.filterWithKey (\ address _ -> Address address `liveMember` roots) m)
+-- | Restrict a 'Heap' to only those addresses in the given 'Live' set (in essence garbage collecting the rest).
+heapRestrict :: Ord location => Heap location cell value -> Live location -> Heap location cell value
+heapRestrict (Heap m) roots = Heap (Monoidal.filterWithKey (\ address _ -> address `liveMember` roots) m)
 
 
-instance (Ord location, Reducer value (cell value)) => Reducer (Address location value, value) (Heap location cell value) where
-  unit = Heap . unit . first unAddress
-  cons (Address key, a) (Heap heap) = Heap (cons (key, a) heap)
-  snoc (Heap heap) (Address key, a) = Heap (snoc heap (key, a))
+instance (Ord location, Reducer value (cell value)) => Reducer (location, value) (Heap location cell value) where
+  unit = Heap . unit
+  cons (addr, a) (Heap heap) = Heap (cons (addr, a) heap)
+  snoc (Heap heap) (addr, a) = Heap (snoc heap (addr, a))
 
 instance (Show location, Show (cell value)) => Show (Heap location cell value) where
   showsPrec d = showsUnaryWith showsPrec "Heap" d . Monoidal.pairs . unHeap

src/Data/Abstract/Live.hs

@@ -1,42 +1,41 @@
 {-# LANGUAGE DataKinds, GeneralizedNewtypeDeriving, TypeFamilies, TypeOperators #-}
 module Data.Abstract.Live where
 
-import Data.Abstract.Address
 import Data.Semilattice.Lower
 import Data.Set as Set
 import Prologue
 
 -- | A set of live addresses (whether roots or reachable).
-newtype Live location value = Live { unLive :: Set location }
+newtype Live location = Live { unLive :: Set location }
   deriving (Eq, Lower, Monoid, Ord, Semigroup)
 
-fromAddresses :: (Foldable t, Ord location) => t (Address location value) -> Live location value
+fromAddresses :: (Foldable t, Ord location) => t location -> Live location
 fromAddresses = Prologue.foldr liveInsert lowerBound
 
 -- | Construct a 'Live' set containing only the given address.
-liveSingleton :: Address location value -> Live location value
-liveSingleton = Live . Set.singleton . unAddress
+liveSingleton :: location -> Live location
+liveSingleton = Live . Set.singleton
 
 -- | Insert an address into a 'Live' set.
-liveInsert :: Ord location => Address location value -> Live location value -> Live location value
-liveInsert addr = Live . Set.insert (unAddress addr) . unLive
+liveInsert :: Ord location => location -> Live location -> Live location
+liveInsert addr = Live . Set.insert addr . unLive
 
 -- | Delete an address from a 'Live' set, if present.
-liveDelete :: Ord location => Address location value -> Live location value -> Live location value
-liveDelete addr = Live . Set.delete (unAddress addr) . unLive
+liveDelete :: Ord location => location -> Live location -> Live location
+liveDelete addr = Live . Set.delete addr . unLive
 
 -- | Compute the (asymmetric) difference of two 'Live' sets, i.e. delete every element of the second set from the first set.
-liveDifference :: Ord location => Live location value -> Live location value -> Live location value
+liveDifference :: Ord location => Live location -> Live location -> Live location
 liveDifference = fmap Live . (Set.difference `on` unLive)
 
--- | Test whether an 'Address' is in a 'Live' set.
-liveMember :: Ord location => Address location value -> Live location value -> Bool
-liveMember addr = Set.member (unAddress addr) . unLive
+-- | Test whether an address is in a 'Live' set.
+liveMember :: Ord location => location -> Live location -> Bool
+liveMember addr = Set.member addr . unLive
 
 -- | Decompose a 'Live' set into a pair of one member address and the remaining set, or 'Nothing' if empty.
-liveSplit :: Live location value -> Maybe (Address location value, Live location value)
-liveSplit = fmap (bimap Address Live) . Set.minView . unLive
+liveSplit :: Live location -> Maybe (location, Live location)
+liveSplit = fmap (fmap Live) . Set.minView . unLive
 
 
-instance Show location => Show (Live location value) where
+instance Show location => Show (Live location) where
   showsPrec d = showsUnaryWith showsPrec "Live" d . Set.toList . unLive

src/Data/Abstract/Type.hs

@@ -132,7 +132,7 @@ instance ( Member (Allocator location Type) effects
       tvar <- Var <$> fresh
       assign a tvar
       bimap (Env.insert name a) (tvar :) <$> rest) (pure (emptyEnv, [])) names
-    (zeroOrMoreProduct tvars :->) <$> localEnv (mergeEnvs env) (body `catchReturn` \ (Return value) -> pure value)
+    (zeroOrMoreProduct tvars :->) <$> locally (bindAll env *> body `catchReturn` \ (Return value) -> pure value)
 
   call op params = do
     tvar <- fresh

src/Data/Abstract/Value.hs

@@ -72,7 +72,7 @@ instance ( Coercible body (Eff effects)
     packageInfo <- currentPackage
     moduleInfo <- currentModule
     i <- fresh
-    Closure packageInfo moduleInfo parameters (ClosureBody i (coerce (lowerEff body))) . Env.bind (foldr Set.delete freeVariables parameters) <$> getEnv
+    Closure packageInfo moduleInfo parameters (ClosureBody i (coerce (lowerEff body))) . Env.intersect (foldr Set.delete freeVariables parameters) <$> getEnv
 
   call op params = do
     case op of
@@ -85,7 +85,7 @@ instance ( Coercible body (Eff effects)
             a <- alloc name
             assign a v
             Env.insert name a <$> rest) (pure env) (zip names params)
-          localEnv (mergeEnvs bindings) (raiseEff (coerce body) `catchReturn` \ (Return value) -> pure value)
+          locally (bindAll bindings *> raiseEff (coerce body) `catchReturn` \ (Return value) -> pure value)
       _ -> throwValueError (CallError op)
 
 

src/Data/Syntax/Declaration.hs

@@ -27,7 +27,7 @@ instance Evaluatable Function where
   eval Function{..} = do
     name <- either (throwEvalError . FreeVariablesError) pure (freeVariable $ subterm functionName)
     (v, addr) <- letrec name (closure (paramNames functionParameters) (Set.fromList (freeVariables functionBody)) (subtermValue functionBody))
-    modifyEnv (Env.insert name addr)
+    bind name addr
     pure (Rval v)
     where paramNames = foldMap (freeVariables . subterm)
 
@@ -53,7 +53,7 @@ instance Evaluatable Method where
   eval Method{..} = do
     name <- either (throwEvalError . FreeVariablesError) pure (freeVariable $ subterm methodName)
     (v, addr) <- letrec name (closure (paramNames methodParameters) (Set.fromList (freeVariables methodBody)) (subtermValue methodBody))
-    modifyEnv (Env.insert name addr)
+    bind name addr
     pure (Rval v)
     where paramNames = foldMap (freeVariables . subterm)
 
@@ -187,7 +187,7 @@ instance Evaluatable Class where
       void $ subtermValue classBody
       classEnv <- Env.head <$> getEnv
       klass name supers classEnv
-    Rval <$> (v <$ modifyEnv (Env.insert name addr))
+    Rval v <$ bind name addr
 
 -- | A decorator in Python
 data Decorator a = Decorator { decoratorIdentifier :: !a, decoratorParamaters :: ![a], decoratorBody :: !a }
@@ -278,7 +278,7 @@ instance Evaluatable TypeAlias where
     v <- subtermValue typeAliasKind
     addr <- lookupOrAlloc name
     assign addr v
-    Rval <$> (modifyEnv (Env.insert name addr) $> v)
+    Rval v <$ bind name addr
 
 instance Declarations a => Declarations (TypeAlias a) where
   declaredName TypeAlias{..} = declaredName typeAliasIdentifier

src/Data/Syntax/Statement.hs

@@ -1,7 +1,6 @@
 {-# LANGUAGE DeriveAnyClass, MultiParamTypeClasses, ScopedTypeVariables, UndecidableInstances, ViewPatterns #-}
 module Data.Syntax.Statement where
 
-import qualified Data.Abstract.Environment as Env
 import Data.Abstract.Evaluatable
 import Data.ByteString.Char8 (unpack)
 import Data.JSON.Fields
@@ -95,7 +94,7 @@ instance Evaluatable Let where
   eval Let{..} = do
     name <- either (throwEvalError . FreeVariablesError) pure (freeVariable $ subterm letVariable)
     addr <- snd <$> letrec name (subtermValue letValue)
-    Rval <$> localEnv (Env.insert name addr) (subtermValue letBody)
+    Rval <$> locally (bind name addr *> subtermValue letBody)
 
 
 -- Assignment
@@ -119,7 +118,7 @@ instance Evaluatable Assignment where
       LvalLocal nam -> do
         addr <- lookupOrAlloc nam
         assign addr rhs
-        modifyEnv (Env.insert nam addr)
+        bind nam addr
       LvalMember _ _ ->
         -- we don't yet support mutable object properties:
         pure ()

src/Language/Go/Syntax.hs

@@ -71,7 +71,7 @@ instance Evaluatable Import where
     for_ paths $ \path -> do
       traceResolve (unPath importPath) path
       importedEnv <- maybe emptyEnv fst <$> isolate (require path)
-      modifyEnv (mergeEnvs importedEnv)
+      bindAll importedEnv
     pure (Rval unit)
 
 
@@ -95,7 +95,7 @@ instance Evaluatable QualifiedImport where
       for_ paths $ \p -> do
         traceResolve (unPath importPath) p
         importedEnv <- maybe emptyEnv fst <$> isolate (require p)
-        modifyEnv (mergeEnvs importedEnv)
+        bindAll importedEnv
       makeNamespace alias addr Nothing
     pure (Rval unit)
 

src/Language/PHP/Syntax.hs

@@ -70,7 +70,7 @@ include pathTerm f = do
   path <- resolvePHPName name
   traceResolve name path
   (importedEnv, v) <- isolate (f path) >>= maybeM (pure (emptyEnv, unit))
-  modifyEnv (mergeEnvs importedEnv)
+  bindAll importedEnv
   pure (Rval v)
 
 newtype Require a = Require a

src/Language/Python/Syntax.hs

@@ -118,7 +118,7 @@ instance Evaluatable Import where
     -- Last module path is the one we want to import
     let path = NonEmpty.last modulePaths
     importedEnv <- maybe emptyEnv fst <$> isolate (require path)
-    modifyEnv (mergeEnvs (select importedEnv))
+    bindAll (select importedEnv)
     pure (Rval unit)
     where
       select importedEnv
@@ -140,7 +140,7 @@ evalQualifiedImport :: ( AbstractValue location value effects
                     => Name -> ModulePath -> Evaluator location value effects value
 evalQualifiedImport name path = letrec' name $ \addr -> do
   importedEnv <- maybe emptyEnv fst <$> isolate (require path)
-  modifyEnv (mergeEnvs importedEnv)
+  bindAll importedEnv
   unit <$ makeNamespace name addr Nothing
 
 newtype QualifiedImport a = QualifiedImport { qualifiedImportFrom :: QualifiedName }
@@ -189,7 +189,7 @@ instance Evaluatable QualifiedAliasedImport where
     Rval <$> letrec' alias (\addr -> do
       let path = NonEmpty.last modulePaths
       importedEnv <- maybe emptyEnv fst <$> isolate (require path)
-      modifyEnv (mergeEnvs importedEnv)
+      bindAll importedEnv
       unit <$ makeNamespace alias addr Nothing)
 
 -- | Ellipsis (used in splice expressions and alternatively can be used as a fill in expression, like `undefined` in Haskell)

src/Language/Ruby/Syntax.hs

@@ -74,7 +74,7 @@ instance Evaluatable Require where
     path <- resolveRubyName name
     traceResolve name path
     (importedEnv, v) <- isolate (doRequire path)
-    modifyEnv (`mergeNewer` importedEnv)
+    bindAll importedEnv
     pure (Rval v) -- Returns True if the file was loaded, False if it was already loaded. http://ruby-doc.org/core-2.5.0/Kernel.html#method-i-require
 
 doRequire :: ( AbstractValue location value effects
@@ -122,7 +122,7 @@ doLoad path shouldWrap = do
   path' <- resolveRubyPath path
   traceResolve path path'
   importedEnv <- maybe emptyEnv fst <$> isolate (load path')
-  unless shouldWrap $ modifyEnv (mergeEnvs importedEnv)
+  unless shouldWrap $ bindAll importedEnv
   pure (boolean Prelude.True) -- load always returns true. http://ruby-doc.org/core-2.5.0/Kernel.html#method-i-load
 
 -- TODO: autoload

src/Language/TypeScript/Syntax.hs

@@ -148,7 +148,7 @@ evalRequire :: ( AbstractValue location value effects
             -> Evaluator location value effects value
 evalRequire modulePath alias = letrec' alias $ \addr -> do
   importedEnv <- maybe emptyEnv fst <$> isolate (require modulePath)
-  modifyEnv (mergeEnvs importedEnv)
+  bindAll importedEnv
   unit <$ makeNamespace alias addr Nothing
 
 data Import a = Import { importSymbols :: ![(Name, Name)], importFrom :: ImportPath }
@@ -165,7 +165,7 @@ instance Evaluatable Import where
   eval (Import symbols importPath) = do
     modulePath <- resolveWithNodejsStrategy importPath typescriptExtensions
     importedEnv <- maybe emptyEnv fst <$> isolate (require modulePath)
-    modifyEnv (mergeEnvs (renamed importedEnv)) $> Rval unit
+    bindAll (renamed importedEnv) $> Rval unit
     where
       renamed importedEnv
         | Prologue.null symbols = importedEnv
@@ -273,7 +273,7 @@ instance Evaluatable DefaultExport where
         addr <- lookupOrAlloc name
         assign addr v
         addExport name name Nothing
-        void $ modifyEnv (Env.insert name addr)
+        void $ bind name addr
       Nothing -> throwEvalError DefaultExportError
     pure (Rval unit)
 
@@ -853,7 +853,7 @@ instance Evaluatable AbstractClass where
       void $ subtermValue classBody
       classEnv <- Env.head <$> getEnv
       klass name supers classEnv
-    Rval <$> (v <$ modifyEnv (Env.insert name addr))
+    Rval v <$ bind name addr
 
 
 data JsxElement a = JsxElement { _jsxOpeningElement :: !a,  _jsxElements :: ![a], _jsxClosingElement :: !a }

test/Analysis/Python/Spec.hs

@@ -44,7 +44,6 @@ spec = parallel $ do
 
   where
     ns n = Just . Latest . Last . Just . Namespace n
-    addr = Address . Precise
     fixtures = "test/fixtures/python/analysis/"
     evaluate entry = evalPythonProject (fixtures <> entry)
     evalPythonProject path = testEvaluating <$> evaluateProject pythonParser Language.Python pythonPrelude path

test/Analysis/Ruby/Spec.hs

@@ -76,7 +76,6 @@ spec = parallel $ do
 
   where
     ns n = Just . Latest . Last . Just . Namespace n
-    addr = Address . Precise
     fixtures = "test/fixtures/ruby/analysis/"
     evaluate entry = evalRubyProject (fixtures <> entry)
     evalRubyProject path = testEvaluating <$> evaluateProject rubyParser Language.Ruby rubyPrelude path

test/Doctests.hs

@@ -6,7 +6,8 @@ import System.Environment
 import Test.DocTest
 
 defaultFiles =
-  [ "src/Data/Abstract/Environment.hs"
+  [ "src/Data/Abstract/Address.hs"
+  , "src/Data/Abstract/Environment.hs"
   , "src/Data/Abstract/Name.hs"
   , "src/Data/Range.hs"
   , "src/Data/Semigroup/App.hs"