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:
parent
c75defc821
commit
29532a114d
@ -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
|
||||
|
@ -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)
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user