1
1
mirror of https://github.com/github/semantic.git synced 2024-12-19 21:01:35 +03:00

Evaluate modules using open recursion.

This commit is contained in:
Rob Rix 2018-09-20 13:12:19 -04:00
parent c75defc821
commit 29532a114d
5 changed files with 14 additions and 20 deletions

View File

@ -93,10 +93,9 @@ convergingModules :: ( AbstractValue address value effects
, Ord address
, Ord term
)
=> SubtermAlgebra Module term (Evaluator term address value effects address)
-> SubtermAlgebra Module term (Evaluator term address value effects address)
=> Open (Module term -> Evaluator term address value effects address)
convergingModules recur m = do
c <- getConfiguration (subterm (moduleBody m))
c <- getConfiguration (moduleBody m)
heap <- getHeap
-- Convergence here is predicated upon an Eq instance, not α-equivalence
(cache, _) <- converge (lowerBound, heap) (\ (prevCache, _) -> isolateCache $ do

View File

@ -91,10 +91,9 @@ convergingModules :: ( AbstractValue address value effects
, Member (State (Heap address value)) effects
, Effects effects
)
=> SubtermAlgebra Module term (Evaluator term address value effects address)
-> SubtermAlgebra Module term (Evaluator term address value effects address)
=> Open (Module term -> Evaluator term address value effects address)
convergingModules recur m = do
c <- getConfiguration (subterm (moduleBody m))
c <- getConfiguration (moduleBody m)
-- Convergence here is predicated upon an Eq instance, not α-equivalence
cache <- converge lowerBound (\ prevCache -> isolateCache $ do
putHeap (configurationHeap c)

View File

@ -44,9 +44,8 @@ killingModules :: ( Foldable (Base term)
, Ord term
, Recursive term
)
=> SubtermAlgebra Module term (Evaluator term address value effects a)
-> SubtermAlgebra Module term (Evaluator term address value effects a)
killingModules recur m = killAll (subterms (subterm (moduleBody m))) *> recur m
=> Open (Module term -> Evaluator term address value effects a)
killingModules recur m = killAll (subterms (moduleBody m)) *> recur m
providingDeadSet :: Effects effects => Evaluator term address value (State (Dead term) ': effects) a -> Evaluator term address value effects (Dead term, a)
providingDeadSet = runState lowerBound

View File

@ -111,8 +111,7 @@ graphingPackages :: ( Member (Reader PackageInfo) effects
, Member (State (Graph ControlFlowVertex)) effects
, Member (Reader ControlFlowVertex) effects
)
=> SubtermAlgebra Module term (Evaluator term address value effects a)
-> SubtermAlgebra Module term (Evaluator term address value effects a)
=> Open (Module term -> Evaluator term address value effects a)
graphingPackages recur m =
let v = moduleVertex (moduleInfo m) in packageInclusion v *> local (const v) (recur m)
@ -124,8 +123,7 @@ graphingModules :: forall term address value effects a
, Member (Reader ControlFlowVertex) effects
, PureEffects effects
)
=> SubtermAlgebra Module term (Evaluator term address value effects a)
-> SubtermAlgebra Module term (Evaluator term address value effects a)
=> Open (Module term -> Evaluator term address value effects a)
graphingModules recur m = do
let v = moduleVertex (moduleInfo m)
appendGraph (vertex v)
@ -147,8 +145,7 @@ graphingModuleInfo :: forall term address value effects a
, Member (State (Graph ModuleInfo)) effects
, PureEffects effects
)
=> SubtermAlgebra Module term (Evaluator term address value effects a)
-> SubtermAlgebra Module term (Evaluator term address value effects a)
=> Open (Module term -> Evaluator term address value effects a)
graphingModuleInfo recur m = do
appendGraph (vertex (moduleInfo m))
eavesdrop @(Modules address) (\ eff -> case eff of

View File

@ -122,7 +122,7 @@ evaluate :: ( AbstractValue address value valueEffects
, valueEffects ~ ValueEffects address value moduleEffects
)
=> proxy lang
-> Open (SubtermAlgebra Module term (Evaluator term address value moduleEffects address))
-> Open (Module term -> Evaluator term address value moduleEffects address)
-> Open (SubtermAlgebra (Base term) term (Evaluator term address value valueEffects (ValueRef address)))
-> (forall x . Evaluator term address value (Deref value ': Allocator address ': Reader ModuleInfo ': effects) x -> Evaluator term address value (Reader ModuleInfo ': effects) x)
-> (forall x . Evaluator term address value valueEffects x -> Evaluator term address value moduleEffects x)
@ -136,14 +136,14 @@ evaluate lang analyzeModule analyzeTerm runAllocDeref runValue modules = do
where run preludeBinds m rest = do
evaluated <- coerce
(runInModule preludeBinds (moduleInfo m))
(analyzeModule (subtermRef . moduleBody)
(evalModuleBody <$> m))
(analyzeModule (evalModuleBody . moduleBody)
m)
-- FIXME: this should be some sort of Monoidal insert à la the Heap to accommodate multiple Go files being part of the same module.
local (ModuleTable.insert (modulePath (moduleInfo m)) ((evaluated <$ m) :| [])) rest
evalModuleBody term = Subterm term (coerce runValue (do
evalModuleBody term = coerce runValue (do
result <- foldSubterms (analyzeTerm eval) term >>= address
result <$ postlude lang))
result <$ postlude lang)
runInModule preludeBinds info
= runReader info