1
1
mirror of https://github.com/github/semantic.git synced 2024-12-22 06:11:49 +03:00

Swap the order of the cell and location parameters to Configuration.

This commit is contained in:
Rob Rix 2018-05-10 19:57:15 -04:00
parent 2383cd05c5
commit 3a7ed73d66
5 changed files with 15 additions and 15 deletions

View File

@ -12,7 +12,7 @@ import Data.Semilattice.Lower
import Prologue
-- | Look up the set of values for a given configuration in the in-cache.
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 location (Cell location) value))
consultOracle :: (Cacheable term (Cell location) location value, Member (Reader (Cache term (Cell location) location value)) effects) => Configuration term location (Cell location) value -> Evaluator location value effects (Set (value, Heap location (Cell location) value))
consultOracle configuration = fromMaybe mempty . cacheLookup configuration <$> ask
-- | Run an action with the given in-cache.
@ -21,11 +21,11 @@ withOracle cache = local (const cache)
-- | Look up the set of values for a given configuration in the out-cache.
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 location (Cell location) value)))
lookupCache :: (Cacheable term (Cell location) location value, Member (State (Cache term (Cell location) location value)) effects) => Configuration term location (Cell location) value -> Evaluator location value effects (Maybe (Set (value, Heap location (Cell location) value)))
lookupCache configuration = cacheLookup configuration <$> get
-- | Run an action, caching its result and 'Heap' under the given configuration.
cachingConfiguration :: (Cacheable term (Cell location) location value, Members '[State (Cache term (Cell location) location value), State (Heap location (Cell location) value)] effects) => Configuration term (Cell location) location value -> Set (value, Heap location (Cell 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 location (Cell location) value)] effects) => Configuration term location (Cell location) value -> Set (value, Heap location (Cell location) value) -> Evaluator location value effects value -> Evaluator location value effects value
cachingConfiguration configuration values action = do
modify' (cacheSet configuration values)
result <- (,) <$> action <*> get

View File

@ -16,17 +16,17 @@ tracingTerms :: ( Corecursive term
, Members '[ Reader (Live location value)
, State (Environment location value)
, State (Heap location (Cell location) value)
, Writer (trace (Configuration term (Cell location) location value))
, Writer (trace (Configuration term location (Cell location) value))
] effects
, Reducer (Configuration term (Cell location) location value) (trace (Configuration term (Cell location) location value))
, Reducer (Configuration term location (Cell location) value) (trace (Configuration term location (Cell location) value))
)
=> trace (Configuration term (Cell location) location value)
=> trace (Configuration term location (Cell location) value)
-> SubtermAlgebra (Base term) term (Evaluator location value effects a)
-> SubtermAlgebra (Base term) term (Evaluator location value effects a)
tracingTerms proxy recur term = getConfiguration (embedSubterm term) >>= trace . (`asTypeOf` proxy) . Reducer.unit >> recur term
trace :: Member (Writer (trace (Configuration term (Cell location) location value))) effects => trace (Configuration term (Cell location) location value) -> Evaluator location value effects ()
trace :: Member (Writer (trace (Configuration term location (Cell location) value))) effects => trace (Configuration term location (Cell location) value) -> Evaluator location value effects ()
trace = tell
tracing :: Monoid (trace (Configuration term (Cell location) location value)) => Evaluator location value (Writer (trace (Configuration term (Cell location) location value)) ': effects) a -> Evaluator location value effects (a, trace (Configuration term (Cell location) location value))
tracing :: Monoid (trace (Configuration term location (Cell location) value)) => Evaluator location value (Writer (trace (Configuration term location (Cell location) value)) ': effects) a -> Evaluator location value effects (a, trace (Configuration term location (Cell location) value))
tracing = runWriter

View File

@ -11,5 +11,5 @@ import Control.Abstract.Roots
import Data.Abstract.Configuration
-- | Get the current 'Configuration' with a passed-in term.
getConfiguration :: Members '[Reader (Live location value), State (Environment location value), State (Heap location (Cell location) value)] effects => term -> Evaluator location value effects (Configuration term (Cell location) location value)
getConfiguration :: Members '[Reader (Live location value), State (Environment location value), State (Heap location (Cell location) value)] effects => term -> Evaluator location value effects (Configuration term location (Cell location) value)
getConfiguration term = Configuration term <$> askRoots <*> getEnv <*> getHeap

View File

@ -8,19 +8,19 @@ import Data.Semilattice.Lower
import Prologue
-- | A map of 'Configuration's to 'Set's of resulting values & 'Heap's.
newtype Cache term cell location value = Cache { unCache :: Monoidal.Map (Configuration term cell location value) (Set (value, Heap location cell value)) }
deriving (Eq, Lower, Monoid, Ord, Reducer (Configuration term cell location value, (value, Heap location cell value)), Show, Semigroup)
newtype Cache term cell location value = Cache { unCache :: Monoidal.Map (Configuration term location cell value) (Set (value, Heap location cell value)) }
deriving (Eq, Lower, Monoid, Ord, Reducer (Configuration term location cell value, (value, Heap location cell value)), Show, Semigroup)
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 cell location value => Configuration term cell location value -> Cache term cell location value -> Maybe (Set (value, Heap location cell value))
cacheLookup :: Cacheable term cell location value => Configuration term location cell value -> Cache term cell location value -> Maybe (Set (value, Heap location cell value))
cacheLookup key = Monoidal.lookup key . unCache
-- | Set the resulting value & 'Heap' for a given 'Configuration', overwriting any previous entry.
cacheSet :: Cacheable term cell location value => Configuration term cell location value -> Set (value, Heap location cell value) -> Cache term cell location value -> Cache term cell location value
cacheSet :: Cacheable term cell location value => Configuration term location cell value -> Set (value, Heap location cell 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 cell location value => Configuration term cell location value -> (value, Heap location cell value) -> Cache term cell location value -> Cache term cell location value
cacheInsert :: Cacheable term cell location value => Configuration term location cell value -> (value, Heap location cell value) -> Cache term cell location value -> Cache term cell location value
cacheInsert = curry cons

View File

@ -5,7 +5,7 @@ import Data.Abstract.Heap
import Data.Abstract.Live
-- | A single point in a programs execution.
data Configuration term cell location value = Configuration
data Configuration term location cell value = Configuration
{ configurationTerm :: term -- ^ The “instruction,” i.e. the current term to evaluate.
, configurationRoots :: Live location value -- ^ The set of rooted addresses.
, configurationEnvironment :: Environment location value -- ^ The environment binding any free variables in 'configurationTerm'.