github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-22 06:11:49 +03:00
Code Issues Projects Releases Wiki Activity

Parameterize Cache by the cell type.

Browse Source
This commit is contained in:
Rob Rix 2018-05-10 12:37:06 -04:00
parent 5d51eb9a5e
commit 423c229c73
2 changed files with 19 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
src/Analysis/Abstract/Caching.hs
View File

@ -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

21
src/Data/Abstract/Cache.hs
View File

@ -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)) }
deriving (Lower)
newtype Cache term cell location value = Cache { unCache :: Monoidal.Map (Configuration term cell location value) (Set (value, Heap cell location value)) }
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)
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)
type Cacheable term cell location value = (Ord (cell value), Ord location, Ord term, Ord 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