diff --git a/src/Semantic/Analysis.hs b/src/Semantic/Analysis.hs index a822a2867..a5bda25db 100644 --- a/src/Semantic/Analysis.hs +++ b/src/Semantic/Analysis.hs @@ -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 diff --git a/src/Semantic/Graph.hs b/src/Semantic/Graph.hs index ef42f3e11..1cff4515b 100644 --- a/src/Semantic/Graph.hs +++ b/src/Semantic/Graph.hs @@ -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 diff --git a/src/Semantic/REPL.hs b/src/Semantic/REPL.hs index 0f8d11003..808996cb1 100644 --- a/src/Semantic/REPL.hs +++ b/src/Semantic/REPL.hs @@ -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 diff --git a/src/Semantic/Util.hs b/src/Semantic/Util.hs index dafa1e92a..7901777df 100644 --- a/src/Semantic/Util.hs +++ b/src/Semantic/Util.hs @@ -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