Factor the Store 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 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)
 
 -- | Functionality used to perform caching analysis. This is not exported, and exists primarily for organizational reasons.

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 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)
 
 -- | A set of “dead” (unreachable) terms.

src/Analysis/Abstract/Evaluating.hs

@@ -77,6 +77,10 @@ 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
   getGlobalEnv = raise get
   putGlobalEnv = raise . put
@@ -84,9 +88,6 @@ instance Members (EvaluatingEffects term value) effects => MonadEvaluator term v
   askLocalEnv = raise ask
   localEnv f a = raise (local f (lower a))
 
-  getStore = raise get
-  putStore = raise . put
-
   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 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)
 
 instance ( Corecursive term

src/Control/Abstract/Evaluator.hs

@@ -14,7 +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 => MonadEvaluator term value m | m -> term, m -> value where
+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
@@ -25,11 +25,6 @@ class MonadFail m => MonadEvaluator term value m | m -> term, m -> value where
   -- | Run an action with a locally-modified environment.
   localEnv :: (EnvironmentFor value -> EnvironmentFor value) -> m a -> m a
 
-  -- | Retrieve the heap.
-  getStore :: m (StoreFor value)
-  -- | Set the heap.
-  putStore :: StoreFor value -> m ()
-
   -- | Retrieve the table of evaluated modules.
   getModuleTable :: m (ModuleTable (EnvironmentFor value))
   -- | Update the table of evaluated modules.
@@ -52,6 +47,13 @@ getConfiguration term = Configuration term <$> askRoots <*> askLocalEnv <*> getS
 modifyGlobalEnv :: MonadEvaluator term value m => (EnvironmentFor value -> EnvironmentFor value) -> m  ()
 modifyGlobalEnv f = getGlobalEnv >>= putGlobalEnv . f
 
+
+class Monad m => MonadStore value m | m -> value where
+  -- | Retrieve the heap.
+  getStore :: m (StoreFor value)
+  -- | Set the heap.
+  putStore :: StoreFor value -> m ()
+
 -- | Update the heap.
-modifyStore :: MonadEvaluator term value m => (StoreFor value -> StoreFor value) -> m ()
+modifyStore :: MonadStore value m => (StoreFor value -> StoreFor value) -> m ()
 modifyStore f = getStore >>= putStore . f