From 830fde2104f8ee13a42d3003741f9108bafab7b6 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 25 Oct 2018 21:22:22 -0400 Subject: [PATCH] Simplify evaluate to take the term evaluator. --- src/Data/Abstract/Evaluatable.hs | 16 ++++------------ src/Semantic/Graph.hs | 2 +- src/Semantic/REPL.hs | 2 +- src/Semantic/Util.hs | 6 +++--- 4 files changed, 9 insertions(+), 17 deletions(-) diff --git a/src/Data/Abstract/Evaluatable.hs b/src/Data/Abstract/Evaluatable.hs index a29f80399..a262ea169 100644 --- a/src/Data/Abstract/Evaluatable.hs +++ b/src/Data/Abstract/Evaluatable.hs @@ -116,40 +116,32 @@ evaluate :: ( AbstractValue term address value valueC , moduleSig ~ (Eavesdrop (Modules address) :+: Interpose (Resumable (BaseError (UnspecializedError value))) :+: Error (LoopControl address) :+: Error (Return address) :+: Env address :+: ScopeEnv address :+: Deref value :+: Allocator address :+: Reader ModuleInfo :+: sig) , Carrier (While value :+: Boolean value :+: moduleSig) whileC , Carrier (Function term address value :+: While value :+: Boolean value :+: moduleSig) valueC - , Declarations term , Effect sig - , Evaluatable (Base term) - , FreeVariables term , HasPrelude lang , Member Fresh sig , Member (Modules address) sig , Member (Reader (ModuleTable (NonEmpty (Module (ModuleResult address))))) sig - , Member (Reader PackageInfo) sig , Member (Reader Span) sig - , Member (State Span) sig , Member (Resumable (BaseError (AddressError address value))) sig , Member (Resumable (BaseError (EnvironmentError address))) sig - , Member (Resumable (BaseError EvalError)) sig - , Member (Resumable (BaseError ResolutionError)) sig , Member (Resumable (BaseError (UnspecializedError value))) sig , Member (State (Heap address value)) sig , Member Trace sig , Ord address - , Recursive term , moduleC ~ ModuleC address value c , valueC ~ ValueC term address value moduleC ) => proxy lang -> Open (Module term -> Evaluator term address value moduleC address) - -> Open (Open (term -> Evaluator term address value valueC (ValueRef address))) + -> (term -> Evaluator term address value valueC address) -> [Module term] -> Evaluator term address value c (ModuleTable (NonEmpty (Module (ModuleResult address)))) -evaluate lang analyzeModule analyzeTerm modules = do - (_, (preludeBinds, _)) <- runInModule lowerBound moduleInfoFromCallStack . runInTerm (evalTerm analyzeTerm) $ do +evaluate lang analyzeModule evalTerm modules = do + (_, (preludeBinds, _)) <- runInModule lowerBound moduleInfoFromCallStack . runInTerm evalTerm $ do definePrelude lang box unit evaluateModules (run preludeBinds <$> modules) - where run preludeBinds m = (<$ m) <$> runInModule preludeBinds (moduleInfo m) (analyzeModule (runInTerm (evalTerm analyzeTerm) . evalTerm analyzeTerm . moduleBody) m) + where run preludeBinds m = (<$ m) <$> runInModule preludeBinds (moduleInfo m) (analyzeModule (runInTerm evalTerm . evalTerm . moduleBody) m) evalTerm :: ( Carrier sig m , Declarations term diff --git a/src/Semantic/Graph.hs b/src/Semantic/Graph.hs index 89644feef..9e07b7c63 100644 --- a/src/Semantic/Graph.hs +++ b/src/Semantic/Graph.hs @@ -268,7 +268,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 id [ setupModule ]) + fst <$> runAnalysis (evaluate (Proxy @'Language.Python) id (evalTerm id) [ setupModule ]) -- FIXME: what are we gonna do about runPythonPackaging Nothing -> pure PythonPackage.Unknown case strat of diff --git a/src/Semantic/REPL.hs b/src/Semantic/REPL.hs index ca9fbbf96..4d6e5257d 100644 --- a/src/Semantic/REPL.hs +++ b/src/Semantic/REPL.hs @@ -120,7 +120,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 (withTermSpans . step (fmap (\ (x:|_) -> moduleBody x) <$> ModuleTable.toPairs (packageModules (fst <$> package)))) modules + $ evaluate proxy id (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 b314daf2b..4522b7bb4 100644 --- a/src/Semantic/Util.hs +++ b/src/Semantic/Util.hs @@ -104,7 +104,7 @@ evaluateProject' (TaskConfig config logger statter) proxy parser paths = either (raiseHandler (runReader (packageInfo package)) (raiseHandler (runState (lowerBound @Span)) (raiseHandler (runReader (lowerBound @Span)) - (evaluate proxy id withTermSpans modules))))))) + (evaluate proxy id (evalTerm withTermSpans) modules))))))) evaluatePythonProjects proxy parser lang path = runTaskWithOptions debugOptions $ do project <- readProject Nothing path lang [] @@ -117,7 +117,7 @@ evaluatePythonProjects proxy parser lang path = runTaskWithOptions debugOptions (raiseHandler (runReader (packageInfo package)) (raiseHandler (runState (lowerBound @Span)) (raiseHandler (runReader (lowerBound @Span)) - (evaluate proxy id withTermSpans modules))))))) + (evaluate proxy id (evalTerm withTermSpans) modules))))))) evaluateProjectWithCaching proxy parser path = runTaskWithOptions debugOptions $ do @@ -130,7 +130,7 @@ evaluateProjectWithCaching proxy parser path = runTaskWithOptions debugOptions $ (raiseHandler (runReader (lowerBound @Span)) (runModuleTable (runModules (ModuleTable.modulePaths (packageModules package)) - (evaluate proxy id withTermSpans modules))))))) + (evaluate proxy id (evalTerm withTermSpans) modules))))))) parseFile :: Parser term -> FilePath -> IO term