mirror of
https://github.com/github/semantic.git
synced 2024-12-11 08:45:48 +03:00
Move pushOrigin into Evaluatable.
This commit is contained in:
parent
1de09bbb25
commit
351f757ed4
@ -149,6 +149,3 @@ instance ( Corecursive term
|
||||
analyzeTerm eval term = pushOrigin (termOrigin (embedSubterm term)) (eval term)
|
||||
|
||||
analyzeModule eval m = pushOrigin (moduleOrigin (subterm <$> m)) (eval m)
|
||||
|
||||
pushOrigin :: Member (Reader (SomeOrigin term)) effects => SomeOrigin term -> Evaluating location term value effects a -> Evaluating location term value effects a
|
||||
pushOrigin o = raise . local (<> o) . lower
|
||||
|
@ -14,6 +14,7 @@ module Data.Abstract.Evaluatable
|
||||
, throwLoadError
|
||||
, require
|
||||
, load
|
||||
, pushOrigin
|
||||
) where
|
||||
|
||||
import Control.Abstract.Addressable as X
|
||||
@ -185,16 +186,16 @@ evaluatePackage :: ( Effectful m
|
||||
)
|
||||
=> Package term
|
||||
-> m effects [value]
|
||||
evaluatePackage p = pushPackage p (localModuleTable (<> packageModules p)
|
||||
evaluatePackage p = pushOrigin (packageOrigin p) (localModuleTable (<> packageModules p)
|
||||
(traverse evaluateEntryPoint (ModuleTable.toPairs (packageEntryPoints p))))
|
||||
where evaluateEntryPoint (m, sym) = do
|
||||
(_, v) <- require m
|
||||
maybe (pure v) ((`call` []) <=< variable) sym
|
||||
|
||||
pushPackage :: ( Effectful m
|
||||
pushOrigin :: ( Effectful m
|
||||
, Member (Reader (SomeOrigin term)) effects
|
||||
)
|
||||
=> Package term
|
||||
=> SomeOrigin term
|
||||
-> m effects a
|
||||
-> m effects a
|
||||
pushPackage p = raise . local (<> packageOrigin p) . lower
|
||||
pushOrigin o = raise . local (<> o) . lower
|
||||
|
Loading…
Reference in New Issue
Block a user