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

Simplify the eavesdropping carriers.

Browse Source
This commit is contained in:
Rob Rix 2018-10-22 13:06:59 -04:00
parent bfe5406fad
commit 08c95f894d
1 changed files with 4 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
src/Analysis/Abstract/Graph.hs
View File

@ -124,13 +124,13 @@ graphingModules :: ( Member (Modules address) sig
, Member (Reader ControlFlowVertex) sig , Member (Reader ControlFlowVertex) sig
, Carrier sig m , Carrier sig m
) )
=> (Module term -> Evaluator term address value (EavesdropC (Modules address) (Evaluator term address value m)) a) => (Module term -> Evaluator term address value (EavesdropC (Modules address) (Eff m)) a)
-> (Module term -> Evaluator term address value m a) -> (Module term -> Evaluator term address value m a)
graphingModules recur m = do graphingModules recur m = do
let v = moduleVertex (moduleInfo m) let v = moduleVertex (moduleInfo m)
appendGraph (vertex v) appendGraph (vertex v)
local (const v) $ local (const v) $
eavesdrop (runEvaluator (recur m)) $ \case Evaluator $ eavesdrop (runEvaluator (recur m)) $ \case
Load path _ -> includeModule path Load path _ -> includeModule path
Lookup path _ -> includeModule path Lookup path _ -> includeModule path
_ -> pure () _ -> pure ()
@ -145,11 +145,11 @@ graphingModuleInfo :: ( Member (Modules address) sig
, Member (State (Graph ModuleInfo)) sig , Member (State (Graph ModuleInfo)) sig
, Carrier sig m , Carrier sig m
) )
=> (Module term -> Evaluator term address value (EavesdropC (Modules address) (Evaluator term address value m)) a) => (Module term -> Evaluator term address value (EavesdropC (Modules address) (Eff m)) a)
-> (Module term -> Evaluator term address value m a) -> (Module term -> Evaluator term address value m a)
graphingModuleInfo recur m = do graphingModuleInfo recur m = do
appendGraph (vertex (moduleInfo m)) appendGraph (vertex (moduleInfo m))
eavesdrop (runEvaluator (recur m)) $ \case Evaluator $ eavesdrop (runEvaluator (recur m)) $ \case
Load path _ -> currentModule >>= appendGraph . (`connect` vertex (ModuleInfo path)) . vertex Load path _ -> currentModule >>= appendGraph . (`connect` vertex (ModuleInfo path)) . vertex
Lookup path _ -> currentModule >>= appendGraph . (`connect` vertex (ModuleInfo path)) . vertex Lookup path _ -> currentModule >>= appendGraph . (`connect` vertex (ModuleInfo path)) . vertex
_ -> pure () _ -> pure ()