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

Extract evaluateEntryPoint to the top level.

Browse Source
This commit is contained in:
Rob Rix 2018-05-01 17:58:21 -04:00
parent 6069c95d1d
commit 0aa506fae5
1 changed files with 16 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -348,11 +348,22 @@ evaluatePackageBody :: ( inner ~ (Reader (ModuleTable [Module term]) ': effects)
evaluatePackageBody body
= withUnevaluatedModules (packageModules body)
. withPrelude (packagePrelude body)
$ traverse evaluateEntryPoint (ModuleTable.toPairs (packageEntryPoints body))
where
evaluateEntryPoint (m, sym) = do
v <- maybe unit (pure . snd) <$> requireWith evalModule m
maybe v ((`call` []) <=< variable) sym
$ traverse (uncurry evaluateEntryPoint) (ModuleTable.toPairs (packageEntryPoints body))
evaluateEntryPoint :: ( Evaluatable (Base term)
, Member (EvalModule term value) effects
, Member Fail effects
, Member (Reader PackageInfo) effects
, MonadAnalysis location term value effects m
, MonadEvaluatable location term value effects m
, Recursive term
)
=> ModulePath
-> Maybe Name
-> m effects value
evaluateEntryPoint m sym = do
v <- maybe unit (pure . snd) <$> requireWith evalModule m
maybe v ((`call` []) <=< variable) sym
withPrelude :: ( Evaluatable (Base term)
, Member (EvalModule term value) effects