Generalize Environment over the address type.

src/Data/Abstract/Configuration.hs

@@ -14,10 +14,10 @@ type ConfigurationFor term value = Configuration (LocationFor value) term value
 -- | A single point in a program’s execution.
 data Configuration l t v
   = Configuration
-    { configurationTerm        :: t               -- ^ The “instruction,” i.e. the current term to evaluate.
-    , configurationRoots       :: Live l v        -- ^ The set of rooted addresses.
-    , configurationEnvironment :: Environment l v -- ^ The environment binding any free variables in 'configurationTerm'.
-    , configurationStore       :: Store l v       -- ^ The store of values.
+    { configurationTerm        :: t                         -- ^ The “instruction,” i.e. the current term to evaluate.
+    , configurationRoots       :: Live l v                  -- ^ The set of rooted addresses.
+    , configurationEnvironment :: Environment (Address l v) -- ^ The environment binding any free variables in 'configurationTerm'.
+    , configurationStore       :: Store l v                 -- ^ The store of values.
     }
     deriving (Generic1)
 

src/Data/Abstract/Environment.hs

@@ -10,24 +10,24 @@ import Data.Semigroup.Reducer
 import qualified Data.Set as Set
 
 -- | A map of names to addresses that represents the evaluation environment.
-newtype Environment l a = Environment { unEnvironment :: Map.Map Name (Address l a) }
+newtype Environment a = Environment { unEnvironment :: Map.Map Name a }
   deriving (Eq, Foldable, Functor, Generic1, Monoid, Ord, Semigroup, Show, Traversable)
 
-deriving instance Reducer (Name, Address l a) (Environment l a)
+deriving instance Reducer (Name, a) (Environment a)
 
 -- | Lookup a 'Name' in the environment.
-envLookup :: Name -> Environment l a -> Maybe (Address l a)
+envLookup :: Name -> Environment (Address l a) -> Maybe (Address l a)
 envLookup k = Map.lookup k . unEnvironment
 
 -- | Insert a 'Name' in the environment.
-envInsert :: Name -> Address l a -> Environment l a -> Environment l a
+envInsert :: Name -> Address l a -> Environment (Address l a) -> Environment (Address l a)
 envInsert name value (Environment m) = Environment (Map.insert name value m)
 
-bindEnv :: (Ord l, Foldable t) => t Name -> Environment l a -> Environment l a
+bindEnv :: (Ord l, Foldable t) => t Name -> Environment (Address l a) -> Environment (Address l a)
 bindEnv names env = foldMap envForName names
   where envForName name = maybe mempty (curry unit name) (envLookup name env)
 
-bindExports :: (Ord l) => Map Name (Name, Maybe (Address l a)) -> Environment l a -> Environment l a
+bindExports :: (Ord l) => Map Name (Name, Maybe (Address l a)) -> Environment (Address l a) -> Environment (Address l a)
 bindExports aliases env = Environment pairs
   where
     pairs = Map.foldrWithKey (\name (alias, address) accum ->
@@ -36,14 +36,14 @@ bindExports aliases env = Environment pairs
 -- | Retrieve the 'Live' set of addresses to which the given free variable names are bound.
 --
 --   Unbound names are silently dropped.
-envRoots :: (Ord l, Foldable t) => Environment l a -> t Name -> Live l a
+envRoots :: (Ord l, Foldable t) => Environment (Address l a) -> t Name -> Live l a
 envRoots env = foldr ((<>) . maybe mempty liveSingleton . flip envLookup env) mempty
 
-envAll :: (Ord l) => Environment l a -> Live l a
+envAll :: (Ord l) => Environment (Address l a) -> Live l a
 envAll (Environment env) = Live $ Set.fromList (Map.elems env)
 
 -- Instances
 
-instance Eq l => Eq1 (Environment l) where liftEq = genericLiftEq
-instance Ord l => Ord1 (Environment l) where liftCompare = genericLiftCompare
-instance Show l => Show1 (Environment l) where liftShowsPrec = genericLiftShowsPrec
+instance Eq1 Environment where liftEq = genericLiftEq
+instance Ord1 Environment where liftCompare = genericLiftCompare
+instance Show1 Environment where liftShowsPrec = genericLiftShowsPrec

src/Data/Abstract/Value.hs

@@ -46,7 +46,7 @@ prjPair = bitraverse prjValue prjValue
 -- TODO: Parameterize Value by the set of constructors s.t. each language can have a distinct value union.
 
 -- | A function value consisting of a list of parameters, the body of the function, and an environment of bindings captured by the body.
-data Closure location term value = Closure [Name] term (Environment location value)
+data Closure location term value = Closure [Name] term (Environment (Address location value))
   deriving (Eq, Generic1, Ord, Show)
 
 instance (Eq location, Eq term) => Eq1 (Closure location term) where liftEq = genericLiftEq
@@ -105,7 +105,7 @@ instance Ord1 Tuple where liftCompare = genericLiftCompare
 instance Show1 Tuple where liftShowsPrec = genericLiftShowsPrec
 
 -- | The environment for an abstract value type.
-type EnvironmentFor v = Environment (LocationFor v) v
+type EnvironmentFor v = Environment (Address (LocationFor v) v)
 
 -- | The store for an abstract value type.
 type StoreFor v = Store (LocationFor v) v