github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-20 21:31:48 +03:00
Code Issues Projects Releases Wiki Activity

Handle Return locally to evalTerm.

Browse Source
This commit is contained in:
Rob Rix 2018-05-06 13:50:58 -04:00
parent 5034140fc7
commit bd997d8564
2 changed files with 6 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
src/Analysis/Abstract/Evaluating.hs
View File

@ -28,8 +28,7 @@ deriving instance (Show (Cell location value), Show location, Show term, Show va
-- | Effects necessary for evaluating (whether concrete or abstract). -- | Effects necessary for evaluating (whether concrete or abstract).
type EvaluatingEffects location term value type EvaluatingEffects location term value
= '[ Return value = '[ LoopControl value
, LoopControl value
, Fail -- Failure with an error message , Fail -- Failure with an error message
, Fresh -- For allocating new addresses and/or type variables. , Fresh -- For allocating new addresses and/or type variables.
, Reader (Environment location value) -- Default environment used as a fallback in lookupEnv , Reader (Environment location value) -- Default environment used as a fallback in lookupEnv
@ -59,6 +58,5 @@ evaluating
-- In general, it’s expected that none of the following effects will remain by the time 'interpret' is called—they should have been handled by local 'interpose's—but if they do, we’ll at least trace. -- In general, it’s expected that none of the following effects will remain by the time 'interpret' is called—they should have been handled by local 'interpose's—but if they do, we’ll at least trace.
. Eff.interpret (\ control -> case control of . Eff.interpret (\ control -> case control of
Break value -> traceM ("Evaluating.interpret: resuming uncaught break with " <> show value) $> value Break value -> traceM ("Evaluating.interpret: resuming uncaught break with " <> show value) $> value
Continue -> traceM "Evaluating.interpret: resuming uncaught continue with hole" $> hole) Continue -> traceM "Evaluating.interpret: resuming uncaught continue with hole" $> hole))
. Eff.interpret (\ (Return value) -> traceM ("Evaluating.interpret: resuming uncaught return with " <> show value) $> value))
-- TODO: Replace 'traceM's with e.g. 'Telemetry'. -- TODO: Replace 'traceM's with e.g. 'Telemetry'.

7
src/Data/Abstract/Evaluatable.hs
View File

@ -324,7 +324,7 @@ evaluatePackageWith :: ( Evaluatable (Base term)
, State (Environment location value) , State (Environment location value)
] effects ] effects
, Recursive term , Recursive term
, termEffects ~ (EvalClosure term value ': moduleEffects) , termEffects ~ (Return value ': EvalClosure term value ': moduleEffects)
, moduleEffects ~ (Reader ModuleInfo ': EvalModule term value ': packageBodyEffects) , moduleEffects ~ (Reader ModuleInfo ': EvalModule term value ': packageBodyEffects)
, packageBodyEffects ~ (Reader LoadStack ': Reader (ModuleTable [Module term]) ': packageEffects) , packageBodyEffects ~ (Reader LoadStack ': Reader (ModuleTable [Module term]) ': packageEffects)
, packageEffects ~ (Reader PackageInfo ': effects) , packageEffects ~ (Reader PackageInfo ': effects)
@ -344,7 +344,7 @@ evaluatePackageBodyWith :: forall location term value effects termEffects module
, State (Environment location value) , State (Environment location value)
] effects ] effects
, Recursive term , Recursive term
, termEffects ~ (EvalClosure term value ': moduleEffects) , termEffects ~ (Return value ': EvalClosure term value ': moduleEffects)
, moduleEffects ~ (Reader ModuleInfo ': EvalModule term value ': packageBodyEffects) , moduleEffects ~ (Reader ModuleInfo ': EvalModule term value ': packageBodyEffects)
, packageBodyEffects ~ (Reader LoadStack ': Reader (ModuleTable [Module term]) ': effects) , packageBodyEffects ~ (Reader LoadStack ': Reader (ModuleTable [Module term]) ': effects)
) )
@ -369,9 +369,10 @@ evaluatePackageBodyWith perModule perTerm body
handleEvalClosures = raiseHandler (relay pure (\ (EvalClosure term) yield -> lower (evalTerm term) >>= yield)) handleEvalClosures = raiseHandler (relay pure (\ (EvalClosure term) yield -> lower (evalTerm term) >>= yield))
evalTerm evalTerm
= handleEvalClosures = handleEvalClosures
. runReturn
. foldSubterms (perTerm eval) . foldSubterms (perTerm eval)
evaluateEntryPoint m sym = handleReader (ModuleInfo m) . handleEvalClosures $ do evaluateEntryPoint m sym = handleReader (ModuleInfo m) . handleEvalClosures . runReturn $ do
v <- maybe unit (pure . snd) <$> require m v <- maybe unit (pure . snd) <$> require m
maybe v ((`call` []) <=< variable) sym maybe v ((`call` []) <=< variable) sym