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

The evalModule action runs in a module context.

Browse Source
This commit is contained in:
Rob Rix 2018-05-09 12:51:22 -04:00
parent 3cbf66c57e
commit 740322ae36
2 changed files with 32 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
src/Control/Abstract/Modules.hs
View File

@ -69,10 +69,12 @@ runModules :: forall term location value effects a
, State (ModuleTable (Maybe (Environment location value, value)))
, Trace
] effects
=> (Module term -> Evaluator location value (Reader (ModuleTable [Module term]) ': effects) value)
=> (Module term -> Evaluator location value (Modules location value ': effects) value)
-> Evaluator location value (Modules location value ': effects) a
-> Evaluator location value (Reader (ModuleTable [Module term]) ': effects) a
runModules evaluateModule = reinterpretEffect (\ m -> case m of
runModules evaluateModule = go
where go :: forall a . Evaluator location value (Modules location value ': effects) a -> Evaluator location value (Reader (ModuleTable [Module term]) ': effects) a
go = reinterpretEffect (\ m -> case m of
Load name -> askModuleTable @term >>= maybe (moduleNotFound name) (runMerging . foldMap (Merging . evalAndCache)) . ModuleTable.lookup name
where
evalAndCache x = do
@ -82,7 +84,7 @@ runModules evaluateModule = reinterpretEffect (\ m -> case m of
if loading
then traceE ("load (skip evaluating, circular load): " <> show mPath) $> Nothing
else do
v <- traceE ("load (evaluating): " <> show mPath) *> evaluateModule x <* traceE ("load done:" <> show mPath)
v <- traceE ("load (evaluating): " <> show mPath) *> go (evaluateModule x) <* traceE ("load done:" <> show mPath)
env <- filterEnv <$> getExports <*> getEnv
cacheModule name (Just (env, v))
pure (Just (env, v))

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

@ -208,6 +208,7 @@ evaluatePackageBodyWith :: forall location term value inner inner' outer
-> Evaluator location value outer [value]
evaluatePackageBodyWith perModule perTerm body
= runReader (packageModules body)
. runModules evalModule
. withPrelude (packagePrelude body)
$ traverse (uncurry evaluateEntryPoint) (ModuleTable.toPairs (packageEntryPoints body))
where evalModule m
@ -216,14 +217,13 @@ evaluatePackageBodyWith perModule perTerm body
. fmap (Subterm <*> foldSubterms (perTerm eval))
$ m
runInModule info
= runModules evalModule
. runReader info
= runReader info
. runReturn
. runLoopControl
. fmap fst
. runGoto lowerBound
evaluateEntryPoint :: ModulePath -> Maybe Name -> Evaluator location value (Reader (ModuleTable [Module term]) ': outer) value
evaluateEntryPoint :: ModulePath -> Maybe Name -> Evaluator location value (Modules location value ': outer) value
evaluateEntryPoint m sym = runInModule (ModuleInfo m) $ do
v <- maybe unit (pure . snd) <$> require m
maybe v ((`call` []) <=< variable) sym