Inline runValueEffects into evaluate.

src/Semantic/Analysis.hs

@@ -2,7 +2,6 @@
 module Semantic.Analysis
 ( evaluate
 , evalTerm
-, runValueEffects
 ) where
 
 import Control.Abstract
@@ -32,22 +31,45 @@ type ValueC 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 :: ( Carrier outerSig outer
+evaluate :: ( AbstractValue term address value (ValueC term address value inner)
+            , Carrier innerSig inner
+            , 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 value))) (Eff inner)))
+            , booleanSig ~ (Boolean value :+: Interpose (Resumable (BaseError (UnspecializedError 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 (Env address) innerSig
+            , Member Fresh innerSig
+            , Member (Reader ModuleInfo) innerSig
             , Member (Reader (ModuleTable (NonEmpty (Module (ModuleResult address))))) outerSig
+            , Member (Reader Span) innerSig
+            , Member (Resumable (BaseError (AddressError address value))) innerSig
+            , Member (Resumable (BaseError (EnvironmentError address))) innerSig
+            , Member (Resumable (BaseError (UnspecializedError value))) innerSig
+            , Member (State (Heap address value)) innerSig
+            , Member Trace innerSig
             , Ord address
             )
-         => lang
-         -> (  (Module (Either lang term) -> Evaluator term address value inner address)
-            -> (Module (Either lang term) -> Evaluator term address value (ModuleC address value outer) address))
-         -> (Either lang term -> Evaluator term address value inner address)
+         => proxy lang
+         -> (  (Module (Either (proxy lang) term) -> Evaluator term address value inner address)
+            -> (Module (Either (proxy lang) term) -> Evaluator term address value (ModuleC address value outer) address))
+         -> (term -> Evaluator term address value (ValueC term address value inner) address)
          -> [Module term]
          -> Evaluator term address value outer (ModuleTable (NonEmpty (Module (ModuleResult address))))
 evaluate lang perModule runTerm modules = do
@@ -59,7 +81,7 @@ evaluate lang perModule runTerm modules = do
           -- 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
 
-        evalModule prelude m = runInModule (perModule (runTerm . moduleBody) m)
+        evalModule prelude m = runInModule (perModule (runValueEffects . moduleBody) m)
           where runInModule
                   = raiseHandler (runReader (moduleInfo m))
                   . runAllocator
@@ -69,6 +91,8 @@ evaluate lang perModule runTerm modules = do
                   . runReturn
                   . runLoopControl
 
+        runValueEffects = raiseHandler runInterpose . runBoolean . runWhile . runFunction runTerm . either ((*> box unit) . definePrelude) runTerm
+
 -- | Evaluate a term recursively, applying the passed function at every recursive position.
 --
 --   This calls out to the 'Evaluatable' instances, will be passed to 'runValueEffects', and can have other functions composed after it to e.g. intercept effects arising in the evaluation of the term.
@@ -105,34 +129,3 @@ evalTerm :: ( Carrier sig m
          => Open (Open (term -> Evaluator term address value m (ValueRef address)))
          -> term -> Evaluator term address value m address
 evalTerm perTerm = fix (perTerm (\ ev -> eval ev . project)) >=> address
-
--- | Run a set of value effects, for which a 'Carrier' is assumed to exist.
-runValueEffects :: ( AbstractValue term address value (ValueC term address value m)
-                   , Carrier sig m
-                   , booleanC ~ BooleanC value (Eff (InterposeC (Resumable (BaseError (UnspecializedError value))) (Eff m)))
-                   , booleanSig ~ (Boolean value :+: Interpose (Resumable (BaseError (UnspecializedError value))) :+: sig)
-                   , 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
-                   , HasPrelude lang
-                   , Member (Allocator address) sig
-                   , Member (Deref value) sig
-                   , Member (Env address) sig
-                   , Member Fresh sig
-                   , Member (Reader ModuleInfo) sig
-                   , Member (Reader Span) sig
-                   , Member (Resumable (BaseError (AddressError address value))) sig
-                   , Member (Resumable (BaseError (EnvironmentError address))) sig
-                   , Member (Resumable (BaseError (UnspecializedError value))) sig
-                   , Member (State (Heap address value)) sig
-                   , Member Trace sig
-                   , Ord address
-                   )
-                => (term -> Evaluator term address value (ValueC term address value m) address)
-                -> Either (proxy lang) term
-                -> Evaluator term address value m address
-runValueEffects evalTerm = raiseHandler runInterpose . runBoolean . runWhile . runFunction evalTerm . either ((*> box unit) . definePrelude) evalTerm

src/Semantic/Graph.hs

@@ -122,7 +122,7 @@ runCallGraph lang includePackages modules package
   . providingLiveSet
   . runModuleTable
   . runModules (ModuleTable.modulePaths (packageModules package))
-  $ evaluate lang perModule (runValueEffects perTerm) modules
+  $ evaluate lang perModule perTerm modules
   where perTerm = evalTerm (withTermSpans . graphingTerms . cachingTerms)
         perModule = (if includePackages then graphingPackages else id) . convergingModules . graphingModules
 
@@ -196,7 +196,7 @@ runImportGraph lang (package :: Package term) f
   . raiseHandler (runReader (packageInfo package))
   . raiseHandler (runState (lowerBound @Span))
   . raiseHandler (runReader (lowerBound @Span))
-  $ evaluate lang graphingModuleInfo (runValueEffects (evalTerm id)) (ModuleTable.toPairs (packageModules package) >>= toList . snd)
+  $ evaluate lang graphingModuleInfo (evalTerm id) (ModuleTable.toPairs (packageModules package) >>= toList . snd)
 
 
 runHeap :: (Carrier sig m, Effect sig) => Evaluator term address value (StateC (Heap address value) (Eff m)) a -> Evaluator term address value m (Heap address value, a)
@@ -260,7 +260,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 (runValueEffects (runPythonPackaging . evalTerm id)) [ setupModule ])
+      fst <$> runAnalysis (evaluate (Proxy @'Language.Python) id (runPythonPackaging . evalTerm id) [ setupModule ])
     Nothing -> pure PythonPackage.Unknown
   case strat of
     PythonPackage.Unknown -> do

src/Semantic/REPL.hs

@@ -121,7 +121,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 (runValueEffects (evalTerm (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

src/Semantic/Util.hs

@@ -105,7 +105,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 (runValueEffects (evalTerm withTermSpans)) modules)))))))
+       (evaluate proxy id (evalTerm withTermSpans) modules)))))))
 
 evaluatePythonProjects proxy parser lang path = runTaskWithOptions debugOptions $ do
   project <- readProject Nothing path lang []
@@ -118,7 +118,7 @@ evaluatePythonProjects proxy parser lang path = runTaskWithOptions debugOptions
        (raiseHandler (runReader (packageInfo package))
        (raiseHandler (runState (lowerBound @Span))
        (raiseHandler (runReader (lowerBound @Span))
-       (evaluate proxy id (runValueEffects (evalTerm withTermSpans)) modules)))))))
+       (evaluate proxy id (evalTerm withTermSpans) modules)))))))
 
 
 evaluateProjectWithCaching proxy parser path = runTaskWithOptions debugOptions $ do
@@ -131,7 +131,7 @@ evaluateProjectWithCaching proxy parser path = runTaskWithOptions debugOptions $
        (raiseHandler (runReader (lowerBound @Span))
        (runModuleTable
        (runModules (ModuleTable.modulePaths (packageModules package))
-       (evaluate proxy id (runValueEffects (evalTerm withTermSpans)) modules)))))))
+       (evaluate proxy id (evalTerm withTermSpans) modules)))))))
 
 
 parseFile :: Parser term -> FilePath -> IO term