github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2025-01-03 13:02:37 +03:00
Code Issues Projects Releases Wiki Activity

evaluatePackageBody provides a Primitive effect.

Browse Source
This commit is contained in:
Rob Rix 2018-05-28 11:16:51 -04:00
parent 0d034f5ddc
commit 20f918e7f7
1 changed files with 3 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -96,7 +96,7 @@ evaluatePackageWith :: forall location term value inner inner' outer
] outer
, Recursive term
, inner ~ (Goto inner' value ': inner')
, inner' ~ (LoopControl value ': Return value ': Allocator location value ': Reader ModuleInfo ': Modules location value ': State (Gotos location value (Reader Span ': Reader PackageInfo ': outer)) ': Reader Span ': Reader PackageInfo ': outer)
, inner' ~ (Primitive ': LoopControl value ': Return value ': Allocator location value ': Reader ModuleInfo ': Modules location value ': State (Gotos location value (Reader Span ': Reader PackageInfo ': outer)) ': Reader Span ': Reader PackageInfo ': outer)
)
=> (SubtermAlgebra Module term (TermEvaluator term location value inner value) -> SubtermAlgebra Module term (TermEvaluator term location value inner value))
-> (SubtermAlgebra (Base term) term (TermEvaluator term location value inner (ValueRef value)) -> SubtermAlgebra (Base term) term (TermEvaluator term location value inner (ValueRef value)))
@ -124,6 +124,7 @@ evaluatePackageWith analyzeModule analyzeTerm package
. raiseHandler runAllocator
. raiseHandler runReturn
. raiseHandler runLoopControl
. runPrimitive
. raiseHandler (runGoto Gotos getGotos)
evaluateEntryPoint :: ModulePath -> Maybe Name -> TermEvaluator term location value (Modules location value ': State (Gotos location value (Reader Span ': Reader PackageInfo ': outer)) ': Reader Span ': Reader PackageInfo ': outer) value
@ -148,7 +149,7 @@ evaluatePackageWith analyzeModule analyzeTerm package
| otherwise = Exports.toEnvironment ports `mergeEnvs` overwrite (Exports.aliases ports) env
pairValueWithEnv action = flip (,) <$> action <*> (filterEnv <$> TermEvaluator getExports <*> TermEvaluator getEnv)
newtype Gotos location value outer = Gotos { getGotos :: GotoTable (LoopControl value ': Return value ': Allocator location value ': Reader ModuleInfo ': Modules location value ': State (Gotos location value outer) ': outer) value }
newtype Gotos location value outer = Gotos { getGotos :: GotoTable (Primitive ': LoopControl value ': Return value ': Allocator location value ': Reader ModuleInfo ': Modules location value ': State (Gotos location value outer) ': outer) value }
deriving (Lower)