Factor the Environment interface out of MonadEvaluator.

src/Analysis/Abstract/Caching.hs

@@ -26,6 +26,7 @@ type CacheFor term value = Cache (LocationFor value) term value
 newtype Caching m term value (effects :: [* -> *]) a = Caching (m term value effects a)
   deriving (Alternative, Applicative, Functor, Effectful, Monad, MonadFail, MonadFresh, MonadNonDet)
 
+deriving instance MonadEnvironment value (m term value effects) => MonadEnvironment value (Caching m term value effects)
 deriving instance MonadStore value (m term value effects) => MonadStore value (Caching m term value effects)
 deriving instance MonadEvaluator term value (m term value effects) => MonadEvaluator term value (Caching m term value effects)
 

src/Analysis/Abstract/Dead.hs

@@ -12,6 +12,7 @@ import Prologue
 newtype DeadCode m term value (effects :: [* -> *]) a = DeadCode (m term value effects a)
   deriving (Alternative, Applicative, Functor, Effectful, Monad, MonadFail, MonadFresh, MonadNonDet)
 
+deriving instance MonadEnvironment value (m term value effects) => MonadEnvironment value (DeadCode m term value effects)
 deriving instance MonadStore value (m term value effects) => MonadStore value (DeadCode m term value effects)
 deriving instance MonadEvaluator term value (m term value effects) => MonadEvaluator term value (DeadCode m term value effects)
 

src/Analysis/Abstract/Evaluating.hs

@@ -77,17 +77,18 @@ type EvaluatingEffects term value
      , State  (ModuleTable (EnvironmentFor value)) -- Cache of evaluated modules
      ]
 
-instance Member (State (StoreFor value)) effects => MonadStore value (Evaluating term value effects) where
-  getStore = raise get
-  putStore = raise . put
-
-instance Members (EvaluatingEffects term value) effects => MonadEvaluator term value (Evaluating term value effects) where
+instance Members '[Reader (EnvironmentFor value), State (EnvironmentFor value)] effects => MonadEnvironment value (Evaluating term value effects) where
   getGlobalEnv = raise get
   putGlobalEnv = raise . put
 
   askLocalEnv = raise ask
   localEnv f a = raise (local f (lower a))
 
+instance Member (State (StoreFor value)) effects => MonadStore value (Evaluating term value effects) where
+  getStore = raise get
+  putStore = raise . put
+
+instance Members (EvaluatingEffects term value) effects => MonadEvaluator term value (Evaluating term value effects) where
   getModuleTable = raise get
   modifyModuleTable f = raise (modify f)
 

src/Analysis/Abstract/Tracing.hs

@@ -16,6 +16,7 @@ import Prologue
 newtype Tracing (trace :: * -> *) m term value (effects :: [* -> *]) a = Tracing (m term value effects a)
   deriving (Alternative, Applicative, Functor, Effectful, Monad, MonadFail, MonadFresh, MonadNonDet)
 
+deriving instance MonadEnvironment value (m term value effects) => MonadEnvironment value (Tracing trace m term value effects)
 deriving instance MonadStore value (m term value effects) => MonadStore value (Tracing trace m term value effects)
 deriving instance MonadEvaluator term value (m term value effects) => MonadEvaluator term value (Tracing trace m term value effects)
 

src/Control/Abstract/Evaluator.hs

@@ -14,17 +14,7 @@ import Prologue
 --   - environments binding names to addresses
 --   - a heap mapping addresses to (possibly sets of) values
 --   - tables of modules available for import
-class (MonadFail m, MonadStore value m) => MonadEvaluator term value m | m -> term, m -> value where
-  -- | Retrieve the global environment.
-  getGlobalEnv :: m (EnvironmentFor value)
-  -- | Set the global environment
-  putGlobalEnv :: EnvironmentFor value -> m ()
-
-  -- | Retrieve the local environment.
-  askLocalEnv :: m (EnvironmentFor value)
-  -- | Run an action with a locally-modified environment.
-  localEnv :: (EnvironmentFor value -> EnvironmentFor value) -> m a -> m a
-
+class (MonadEnvironment value m, MonadFail m, MonadStore value m) => MonadEvaluator term value m | m -> term, m -> value where
   -- | Retrieve the table of evaluated modules.
   getModuleTable :: m (ModuleTable (EnvironmentFor value))
   -- | Update the table of evaluated modules.
@@ -43,6 +33,17 @@ class (MonadFail m, MonadStore value m) => MonadEvaluator term value m | m -> te
 getConfiguration :: (MonadEvaluator term value m, Ord (LocationFor value)) => term -> m (ConfigurationFor term value)
 getConfiguration term = Configuration term <$> askRoots <*> askLocalEnv <*> getStore
 
+class Monad m => MonadEnvironment value m | m -> value where
+  -- | Retrieve the global environment.
+  getGlobalEnv :: m (EnvironmentFor value)
+  -- | Set the global environment
+  putGlobalEnv :: EnvironmentFor value -> m ()
+
+  -- | Retrieve the local environment.
+  askLocalEnv :: m (EnvironmentFor value)
+  -- | Run an action with a locally-modified environment.
+  localEnv :: (EnvironmentFor value -> EnvironmentFor value) -> m a -> m a
+
 -- | Update the global environment.
 modifyGlobalEnv :: MonadEvaluator term value m => (EnvironmentFor value -> EnvironmentFor value) -> m  ()
 modifyGlobalEnv f = getGlobalEnv >>= putGlobalEnv . f