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

Factor the domain effects out of evaluate completely.

Browse Source
This commit is contained in:
Rob Rix 2018-12-11 14:03:09 -05:00
parent 79c0456077
commit 40737635f0
4 changed files with 15 additions and 42 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
src/Semantic/Analysis.hs
View File

@ -1,6 +1,7 @@
{-# LANGUAGE TypeFamilies, TypeOperators #-}
module Semantic.Analysis
( evaluate
, runDomainEffects
, evalTerm
) where
@ -11,6 +12,7 @@ import Data.Abstract.Evaluatable
import Data.Abstract.Module
import Data.Abstract.ModuleTable as ModuleTable
import Data.Function
import Data.Language (Language)
import Prologue
import qualified Data.Map.Strict as Map
@ -32,54 +34,25 @@ type DomainC term address value m
m)))))))
-- | Evaluate a list of modules with the prelude for the passed language available, and applying the passed function to every module.
evaluate :: ( AbstractValue term address value (DomainC term address value inner)
, Carrier innerSig inner
, Carrier outerSig outer
evaluate :: ( Carrier outerSig outer
, derefSig ~ (Deref value :+: allocatorSig)
, derefC ~ (DerefC address value (Eff allocatorC))
, Carrier derefSig derefC
, allocatorSig ~ (Allocator address :+: Reader ModuleInfo :+: outerSig)
, allocatorC ~ (AllocatorC address (Eff (ReaderC ModuleInfo (Eff outer))))
, Carrier allocatorSig allocatorC
, booleanC ~ BooleanC value (Eff (InterposeC (Resumable (BaseError (UnspecializedError address value))) (Eff inner)))
, booleanSig ~ (Boolean value :+: Interpose (Resumable (BaseError (UnspecializedError address value))) :+: innerSig)
, Carrier booleanSig booleanC
, whileC ~ WhileC value (Eff booleanC)
, whileSig ~ (While value :+: booleanSig)
, Carrier whileSig whileC
, functionC ~ FunctionC term address value (Eff whileC)
, functionSig ~ (Function term address value :+: whileSig)
, Carrier functionSig functionC
, Effect outerSig
, HasPrelude lang
, Member Fresh outerSig
, Member (Allocator address) innerSig
, Member (Deref value) innerSig
, Member Fresh innerSig
, Member (Reader ModuleInfo) innerSig
, Member (Reader (ModuleTable (Module (ModuleResult address value)))) outerSig
, Member (Reader Span) innerSig
, Member (Resumable (BaseError (AddressError address value))) innerSig
, Member (Resumable (BaseError (UnspecializedError address value))) innerSig
, Member (State (Heap address address value)) innerSig
, Member (State (ScopeGraph address)) innerSig
, Member (State (Heap address address value)) outerSig
, Member (State (ScopeGraph address)) outerSig
, Member (Reader (CurrentFrame address)) innerSig
, Member (Reader (CurrentScope address)) innerSig
, Member (Resumable (BaseError (HeapError address))) innerSig
, Member (Resumable (BaseError (ScopeError address))) innerSig
, Member Trace innerSig
, Ord address
, Show address
)
=> proxy lang
-> ( (Module (Either (proxy lang) term) -> Evaluator term address value inner value)
-> (Module (Either (proxy lang) term) -> Evaluator term address value (ModuleC address value outer) value))
-> (term -> Evaluator term address value (DomainC term address value inner) value)
=> proxy (lang :: Language)
-> (Module (Either (proxy lang) term) -> Evaluator term address value (ModuleC address value outer) value)
-> [Module term]
-> Evaluator term address value outer (ModuleTable (Module (ModuleResult address value)))
evaluate lang perModule runTerm modules = do
evaluate lang runModule modules = do
let prelude = Module moduleInfoFromCallStack (Left lang)
((preludeScopeAddress, preludeFrameAddress), _) <- evalModule Nothing Nothing prelude
foldr (run preludeScopeAddress preludeFrameAddress . fmap Right) ask modules
@ -103,7 +76,7 @@ evaluate lang perModule runTerm modules = do
. raiseHandler (runReader (CurrentScope scopeAddress))
. runReturn
. runLoopControl
. perModule (runDomainEffects runTerm)
. runModule
runDomainEffects :: ( AbstractValue term address value (DomainC term address value m)
, Carrier sig m

8
src/Semantic/Graph.hs
View File

@ -133,9 +133,9 @@ runCallGraph lang includePackages modules package
. providingLiveSet
. runModuleTable
. runModules (ModuleTable.modulePaths (packageModules package))
$ evaluate lang perModule perTerm modules
$ evaluate lang perModule modules
where perTerm = evalTerm (withTermSpans . graphingTerms . cachingTerms)
perModule = (if includePackages then graphingPackages else id) . convergingModules . graphingModules
perModule = (if includePackages then graphingPackages else id) . convergingModules . graphingModules $ runDomainEffects perTerm
runModuleTable :: Carrier sig m
@ -210,7 +210,7 @@ runImportGraph lang (package :: Package term) f
. raiseHandler (runReader (lowerBound @Span))
. raiseHandler (runState (lowerBound @(ScopeGraph (Hole (Maybe Name) Precise))))
. runAllocator
$ evaluate lang graphingModuleInfo (evalTerm id) (ModuleTable.toPairs (packageModules package) >>= toList . snd)
$ evaluate lang (graphingModuleInfo (runDomainEffects (evalTerm id))) (ModuleTable.toPairs ( packageModules package) >>= toList . snd)
runHeap :: (Carrier sig m, Effect sig)
=> Evaluator term address value (StateC (Heap address address value) (Eff m)) a
@ -284,7 +284,7 @@ parsePythonPackage parser project = do
strat <- case find ((== (projectRootDir project </> "setup.py")) . filePath) (projectFiles project) of
Just setupFile -> do
setupModule <- fmap snd <$> parseModule project parser setupFile
fst <$> runAnalysis (evaluate (Proxy @'Language.Python) id (runPythonPackaging . evalTerm id) [ setupModule ])
fst <$> runAnalysis (evaluate (Proxy @'Language.Python) (runDomainEffects (runPythonPackaging . evalTerm id)) [ setupModule ])
Nothing -> pure PythonPackage.Unknown
case strat of
PythonPackage.Unknown -> do

2
src/Semantic/REPL.hs
View File

@ -92,7 +92,7 @@ repl proxy parser paths = defaultConfig debugOptions >>= \ config -> runM . runD
. raiseHandler (runReader (packageInfo package))
. raiseHandler (runState (lowerBound @Span))
. raiseHandler (runReader (lowerBound @Span))
$ evaluate proxy id (evalTerm (withTermSpans . step (fmap (\ (x:|_) -> moduleBody x) <$> ModuleTable.toPairs (packageModules (fst <$> package))))) modules
$ evaluate proxy (runDomainEffects (evalTerm (withTermSpans . step (fmap (\ (x:|_) -> moduleBody x) <$> ModuleTable.toPairs (packageModules (fst <$> package)))))) modules
-- TODO: REPL for typechecking/abstract semantics
-- TODO: drive the flow from within the REPL instead of from without

6
src/Semantic/Util.hs
View File

@ -111,7 +111,7 @@ evaluateProject' (TaskConfig config logger statter) proxy parser paths = either
(raiseHandler (runReader (packageInfo package))
(raiseHandler (evalState (lowerBound @Span))
(raiseHandler (runReader (lowerBound @Span))
(evaluate proxy id (evalTerm withTermSpans) modules)))))))
(evaluate proxy (runDomainEffects (evalTerm withTermSpans)) modules)))))))
evaluatePythonProjects proxy parser lang path = runTaskWithOptions debugOptions $ do
project <- readProject Nothing path lang []
@ -124,7 +124,7 @@ evaluatePythonProjects proxy parser lang path = runTaskWithOptions debugOptions
(raiseHandler (runReader (packageInfo package))
(raiseHandler (evalState (lowerBound @Span))
(raiseHandler (runReader (lowerBound @Span))
(evaluate proxy id (evalTerm withTermSpans) modules)))))))
(evaluate proxy (runDomainEffects (evalTerm withTermSpans)) modules)))))))
evaluateProjectWithCaching proxy parser path = runTaskWithOptions debugOptions $ do
@ -137,7 +137,7 @@ evaluateProjectWithCaching proxy parser path = runTaskWithOptions debugOptions $
(raiseHandler (runReader (lowerBound @Span))
(runModuleTable
(runModules (ModuleTable.modulePaths (packageModules package))
(evaluate proxy id (evalTerm withTermSpans) modules)))))))
(evaluate proxy (runDomainEffects (evalTerm withTermSpans)) modules)))))))
parseFile :: Parser term -> FilePath -> IO term