Parameterize Cache by the cell type.

src/Analysis/Abstract/Caching.hs

@@ -13,42 +13,42 @@ import Data.Semilattice.Lower
 import Prologue
 
 -- | Look up the set of values for a given configuration in the in-cache.
-consultOracle :: (Cacheable term location value, Member (Reader (Cache term location value)) effects) => Configuration term (Cell location) location value -> Evaluator location value effects (Set (value, Heap (Cell location) location value))
+consultOracle :: (Cacheable term (Cell location) location value, Member (Reader (Cache term (Cell location) location value)) effects) => Configuration term (Cell location) location value -> Evaluator location value effects (Set (value, Heap (Cell location) location value))
 consultOracle configuration = raise (fromMaybe mempty . cacheLookup configuration <$> ask)
 
 -- | Run an action with the given in-cache.
-withOracle :: Member (Reader (Cache term location value)) effects => Cache term location value -> Evaluator location value effects a -> Evaluator location value effects a
+withOracle :: Member (Reader (Cache term (Cell location) location value)) effects => Cache term (Cell location) location value -> Evaluator location value effects a -> Evaluator location value effects a
 withOracle cache = raiseHandler (local (const cache))
 
 
 -- | Look up the set of values for a given configuration in the out-cache.
-lookupCache :: (Cacheable term location value, Member (State (Cache term location value)) effects) => Configuration term (Cell location) location value -> Evaluator location value effects (Maybe (Set (value, Heap (Cell location) location value)))
+lookupCache :: (Cacheable term (Cell location) location value, Member (State (Cache term (Cell location) location value)) effects) => Configuration term (Cell location) location value -> Evaluator location value effects (Maybe (Set (value, Heap (Cell location) location value)))
 lookupCache configuration = raise (cacheLookup configuration <$> get)
 
 -- | Run an action, caching its result and 'Heap' under the given configuration.
-cachingConfiguration :: (Cacheable term location value, Members '[State (Cache term location value), State (Heap (Cell location) location value)] effects) => Configuration term (Cell location) location value -> Set (value, Heap (Cell location) location value) -> Evaluator location value effects value -> Evaluator location value effects value
+cachingConfiguration :: (Cacheable term (Cell location) location value, Members '[State (Cache term (Cell location) location value), State (Heap (Cell location) location value)] effects) => Configuration term (Cell location) location value -> Set (value, Heap (Cell location) location value) -> Evaluator location value effects value -> Evaluator location value effects value
 cachingConfiguration configuration values action = do
   raise (modify (cacheSet configuration values))
   result <- (,) <$> action <*> raise get
   raise (modify (cacheInsert configuration result))
   pure (fst result)
 
-putCache :: Member (State (Cache term location value)) effects => Cache term location value -> Evaluator location value effects ()
+putCache :: Member (State (Cache term (Cell location) location value)) effects => Cache term (Cell location) location value -> Evaluator location value effects ()
 putCache = raise . put
 
 -- | Run an action starting from an empty out-cache, and return the out-cache afterwards.
-isolateCache :: forall term location value effects a . Member (State (Cache term location value)) effects => Evaluator location value effects a -> Evaluator location value effects (Cache term location value)
+isolateCache :: forall term location value effects a . Member (State (Cache term (Cell location) location value)) effects => Evaluator location value effects a -> Evaluator location value effects (Cache term (Cell location) location value)
 isolateCache action = putCache @term lowerBound *> action *> raise get
 
 
 -- | Analyze a term using the in-cache as an oracle & storing the results of the analysis in the out-cache.
-cachingTerms :: ( Cacheable term location value
+cachingTerms :: ( Cacheable term (Cell location) location value
                 , Corecursive term
                 , Members '[ Fresh
                            , NonDet
-                           , Reader (Cache term location value)
+                           , Reader (Cache term (Cell location) location value)
                            , Reader (Live location value)
-                           , State (Cache term location value)
+                           , State (Cache term (Cell location) location value)
                            , State (Environment location value)
                            , State (Heap (Cell location) location value)
                            ] effects
@@ -64,12 +64,12 @@ cachingTerms recur term = do
       pairs <- consultOracle c
       cachingConfiguration c pairs (recur term)
 
-convergingModules :: ( Cacheable term location value
+convergingModules :: ( Cacheable term (Cell location) location value
                      , Members '[ Fresh
                                 , NonDet
-                                , Reader (Cache term location value)
+                                , Reader (Cache term (Cell location) location value)
                                 , Reader (Live location value)
-                                , State (Cache term location value)
+                                , State (Cache term (Cell location) location value)
                                 , State (Environment location value)
                                 , State (Heap (Cell location) location value)
                                 ] effects
@@ -115,7 +115,7 @@ scatter :: (Foldable t, Members '[NonDet, State (Heap (Cell location) location v
 scatter = foldMapA (\ (value, heap') -> putHeap heap' $> value)
 
 
-caching :: Alternative f => Evaluator location value (NonDet ': Reader (Cache term location value) ': State (Cache term location value) ': effects) a -> Evaluator location value effects (f a, Cache term location value)
+caching :: Alternative f => Evaluator location value (NonDet ': Reader (Cache term (Cell location) location value) ': State (Cache term (Cell location) location value) ': effects) a -> Evaluator location value effects (f a, Cache term (Cell location) location value)
 caching
   = runState lowerBound
   . runReader lowerBound

src/Data/Abstract/Cache.hs

@@ -1,7 +1,6 @@
 {-# LANGUAGE ConstraintKinds, GeneralizedNewtypeDeriving, TypeFamilies #-}
 module Data.Abstract.Cache where
 
-import Data.Abstract.Address
 import Data.Abstract.Configuration
 import Data.Abstract.Heap
 import Data.Map.Monoidal as Monoidal
@@ -9,27 +8,19 @@ import Data.Semilattice.Lower
 import Prologue
 
 -- | A map of 'Configuration's to 'Set's of resulting values & 'Heap's.
-newtype Cache term location value = Cache { unCache :: Monoidal.Map (Configuration term (Cell location) location value) (Set (value, Heap (Cell location) location value)) }
+newtype Cache term cell location value = Cache { unCache :: Monoidal.Map (Configuration term cell location value) (Set (value, Heap cell location value)) }
-  deriving (Lower)
+  deriving (Eq, Lower, Monoid, Ord, Reducer (Configuration term cell location value, (value, Heap cell location value)), Show, Semigroup)
 
-type Cacheable term location value = (Ord (Cell location value), Ord location, Ord term, Ord value)
+type Cacheable term cell location value = (Ord (cell value), Ord location, Ord term, Ord value)
-
-deriving instance (Eq   term, Eq   location, Eq   value, Eq   (Cell location value)) => Eq   (Cache term location value)
-deriving instance (Ord  term, Ord  location, Ord  value, Ord  (Cell location value)) => Ord  (Cache term location value)
-deriving instance (Show term, Show location, Show value, Show (Cell location value)) => Show (Cache term location value)
-
-deriving instance Cacheable term location value => Semigroup (Cache term location value)
-deriving instance Cacheable term location value => Monoid    (Cache term location value)
-deriving instance (Cacheable term location value, cell ~ Cell location) => Reducer (Configuration term cell location value, (value, Heap cell location value)) (Cache term location value)
 
 -- | Look up the resulting value & 'Heap' for a given 'Configuration'.
-cacheLookup :: Cacheable term location value => Configuration term (Cell location) location value -> Cache term location value -> Maybe (Set (value, Heap (Cell location) location value))
+cacheLookup :: Cacheable term cell location value => Configuration term cell location value -> Cache term cell location value -> Maybe (Set (value, Heap cell location value))
 cacheLookup key = Monoidal.lookup key . unCache
 
 -- | Set the resulting value & 'Heap' for a given 'Configuration', overwriting any previous entry.
-cacheSet :: Cacheable term location value => Configuration term (Cell location) location value -> Set (value, Heap (Cell location) location value) -> Cache term location value -> Cache term location value
+cacheSet :: Cacheable term cell location value => Configuration term cell location value -> Set (value, Heap cell location value) -> Cache term cell location value -> Cache term cell location value
 cacheSet key value = Cache . Monoidal.insert key value . unCache
 
 -- | Insert the resulting value & 'Heap' for a given 'Configuration', appending onto any previous entry.
-cacheInsert :: Cacheable term location value => Configuration term (Cell location) location value -> (value, Heap (Cell location) location value) -> Cache term location value -> Cache term location value
+cacheInsert :: Cacheable term cell location value => Configuration term cell location value -> (value, Heap cell location value) -> Cache term cell location value -> Cache term cell location value
 cacheInsert = curry cons