1
1
mirror of https://github.com/github/semantic.git synced 2024-11-28 10:15:55 +03:00

expand Ctx to EvalContext in get, put, and with function names

This commit is contained in:
Charlie Somerville 2018-08-08 12:21:48 +10:00
parent cd654ade6c
commit e92846c518
5 changed files with 22 additions and 22 deletions

View File

@ -94,7 +94,7 @@ convergingModules recur m = do
-- Convergence here is predicated upon an Eq instance, not α-equivalence
cache <- converge lowerBound (\ prevCache -> isolateCache $ do
TermEvaluator (putHeap (configurationHeap c))
TermEvaluator (putCtx (configurationContext c))
TermEvaluator (putEvalContext (configurationContext c))
-- We need to reset fresh generation so that this invocation converges.
resetFresh 0 $
-- This is subtle: though the calling context supports nondeterminism, we want

View File

@ -2,9 +2,9 @@
module Control.Abstract.Environment
( Environment
, Exports
, getCtx
, putCtx
, withCtx
, getEvalContext
, putEvalContext
, withEvalContext
, getEnv
, export
, lookupEnv
@ -30,26 +30,26 @@ import Data.Abstract.Name
import Prologue
-- | Retrieve the current execution context
getCtx :: Member (Env address) effects => Evaluator address value effects (EvalContext address)
getCtx = send GetCtx
getEvalContext :: Member (Env address) effects => Evaluator address value effects (EvalContext address)
getEvalContext = send GetCtx
-- | Retrieve the current environment
getEnv :: Member (Env address) effects => Evaluator address value effects (Environment address)
getEnv = ctxEnvironment <$> getCtx
getEnv = ctxEnvironment <$> getEvalContext
-- | Replace the execution context. This is only for use in Analysis.Abstract.Caching.
putCtx :: Member (Env address) effects => EvalContext address -> Evaluator address value effects ()
putCtx = send . PutCtx
putEvalContext :: Member (Env address) effects => EvalContext address -> Evaluator address value effects ()
putEvalContext = send . PutCtx
withCtx :: Member (Env address) effects
withEvalContext :: Member (Env address) effects
=> EvalContext address
-> Evaluator address value effects a
-> Evaluator address value effects a
withCtx ctx comp = do
oldCtx <- getCtx
putCtx ctx
withEvalContext ctx comp = do
oldCtx <- getEvalContext
putEvalContext ctx
value <- comp
putCtx oldCtx
putEvalContext oldCtx
pure value
-- | Add an export to the global export state.
@ -77,7 +77,7 @@ close :: Member (Env address) effects => Set Name -> Evaluator address value eff
close = send . Close
self :: Member (Env address) effects => Evaluator address value effects (Maybe address)
self = ctxSelf <$> getCtx
self = ctxSelf <$> getEvalContext
-- Effects

View File

@ -39,7 +39,7 @@ import Prologue
-- | Get the current 'Configuration' with a passed-in term.
getConfiguration :: (Member (Reader (Live address)) effects, Member (Env address) effects, Member (State (Heap address (Cell address) value)) effects) => term -> TermEvaluator term address value effects (Configuration term address (Cell address) value)
getConfiguration term = Configuration term <$> TermEvaluator askRoots <*> TermEvaluator getCtx <*> TermEvaluator getHeap
getConfiguration term = Configuration term <$> TermEvaluator askRoots <*> TermEvaluator getEvalContext <*> TermEvaluator getHeap
-- | Retrieve the heap.

View File

@ -219,7 +219,7 @@ evaluateInScopedEnv :: ( AbstractValue address value effects
evaluateInScopedEnv receiver term = do
scopedEnv <- scopedEnvironment receiver
env <- maybeM getEnv scopedEnv
withCtx (EvalContext (Just receiver) env) term
withEvalContext (EvalContext (Just receiver) env) term
-- | Evaluates a 'Value' returning the referenced value

View File

@ -87,7 +87,7 @@ runFunction toEvaluator fromEvaluator = interpret $ \case
withCurrentPackage packageInfo . withCurrentModule moduleInfo $ do
bindings <- foldr (\ (name, addr) rest -> Env.insert name addr <$> rest) (pure lowerBound) (zip names params)
let fnCtx = EvalContext (Just self) (Env.push env)
withCtx fnCtx (catchReturn (bindAll bindings *> runFunction toEvaluator fromEvaluator (toEvaluator body)))
withEvalContext fnCtx (catchReturn (bindAll bindings *> runFunction toEvaluator fromEvaluator (toEvaluator body)))
_ -> throwValueError (CallError op) >>= box