1
1
mirror of https://github.com/github/semantic.git synced 2024-12-30 02:14:20 +03:00

Use Evaluator’s definitions of runEvalModule/runEvalClosure.

This commit is contained in:
Rob Rix 2018-05-06 14:42:49 -04:00
parent c8dd3bc718
commit 6c161b1252

View File

@ -355,25 +355,22 @@ evaluatePackageBodyWith :: forall location term value effects termEffects module
evaluatePackageBodyWith perModule perTerm body
= runReader (packageModules body)
. runReader lowerBound
. runEvalModule
. runEvalModule evalModule
. withPrelude (packagePrelude body)
$ traverse (uncurry evaluateEntryPoint) (ModuleTable.toPairs (packageEntryPoints body))
where runEvalModule :: Evaluator location term value (EvalModule term value ': packageBodyEffects) a -> Evaluator location term value packageBodyEffects a
runEvalModule = raiseHandler (relay pure (\ (EvalModule m) yield -> lower (evalModule m) >>= yield))
evalModule m
= runEvalModule
where evalModule m
= runEvalModule evalModule
. runReader (moduleInfo m)
. perModule (subtermValue . moduleBody)
. fmap (Subterm <*> evalTerm)
$ m
runEvalClosure = raiseHandler (relay pure (\ (EvalClosure term) yield -> lower (evalTerm term) >>= yield))
evalTerm
= runEvalClosure
= runEvalClosure evalTerm
. runReturn
. runLoopControl
. foldSubterms (perTerm eval)
evaluateEntryPoint m sym = runReader (ModuleInfo m) . runEvalClosure . runReturn . runLoopControl $ do
evaluateEntryPoint m sym = runReader (ModuleInfo m) . runEvalClosure evalTerm . runReturn . runLoopControl $ do
v <- maybe unit (pure . snd) <$> require m
maybe v ((`call` []) <=< variable) sym