Load & require use an EvalModule effect.

src/Analysis/Abstract/Evaluating.hs

@@ -21,6 +21,7 @@ deriving instance Member NonDet effects => Alternative (Evaluating location term
 -- | Effects necessary for evaluating (whether concrete or abstract).
 type EvaluatingEffects location term value
   = '[ EvalClosure term value
+     , EvalModule term value
      , Return value
      , LoopControl value
      , Fail                                        -- Failure with an error message
@@ -70,4 +71,5 @@ instance (AbstractHole value, Show term, Show value) => Interpreter (Evaluating
         Break value -> traceM ("Evaluating.interpret: resuming uncaught break with " <> show value) $> value
         Continue    -> traceM ("Evaluating.interpret: resuming uncaught continue with hole") $> hole)
       . Eff.interpret (\ (Return value) -> traceM ("Evaluating.interpret: resuming uncaught return with " <> show value) $> value)
+      . Eff.interpret (\ (EvalModule m) -> traceM ("Evaluating.interpret: resuming uncaught EvalModule of " <> show m <> " with hole") $> hole)
       . Eff.interpret (\ (EvalClosure term) -> traceM ("Evaluating.interpret: resuming uncaught EvalClosure of " <> show term <> " with hole") $> hole))

src/Control/Abstract/Evaluator.hs

@@ -49,6 +49,8 @@ module Control.Abstract.Evaluator
   -- Effects
   , EvalClosure(..)
   , evaluateClosureBody
+  , EvalModule(..)
+  , evaluateModule
   , Return(..)
   , earlyReturn
   , catchReturn
@@ -370,6 +372,14 @@ evaluateClosureBody :: (Effectful m, Member (EvalClosure term value) effects) =>
 evaluateClosureBody = raise . Eff.send . EvalClosure
 
 
+-- | An effect to evaluate a module.
+data EvalModule term value resume where
+  EvalModule :: Module term -> EvalModule term value value
+
+evaluateModule :: (Effectful m, Member (EvalModule term value) effects) => Module term -> m effects value
+evaluateModule = raise . Eff.send . EvalModule
+
+
 -- | An effect for explicitly returning out of a function/method body.
 data Return value resume where
   Return :: value -> Return value value

src/Data/Abstract/Evaluatable.hs

@@ -8,7 +8,6 @@ module Data.Abstract.Evaluatable
 , LoadError(..)
 , ResolutionError(..)
 , variable
-, evaluateModule
 , evaluatePackage
 , evaluatePackageBody
 , throwLoadError
@@ -46,6 +45,7 @@ type MonadEvaluatable location term value effects m =
   , Evaluatable (Base term)
   , FreeVariables term
   , Member (EvalClosure term value) effects
+  , Member (EvalModule term value) effects
   , Member Fail effects
   , Member (LoopControl value) effects
   , Member (Resumable (Unspecialized value)) effects
@@ -194,7 +194,13 @@ listModulesInDir dir = ModuleTable.modulePathsInDir dir <$> askModuleTable
 require :: MonadEvaluatable location term value effects m
         => ModulePath
         -> m effects (Environment location value, value)
-require name = getModuleTable >>= maybeM (load name) . ModuleTable.lookup name
+require = requireWith evaluateModule
+
+requireWith :: MonadEvaluatable location term value effects m
+            => (Module term -> m effects value)
+            -> ModulePath
+            -> m effects (Environment location value, value)
+requireWith with name = getModuleTable >>= maybeM (loadWith with name) . ModuleTable.lookup name
 
 -- | Load another module by name and return it's environment and value.
 --
@@ -202,7 +208,13 @@ require name = getModuleTable >>= maybeM (load name) . ModuleTable.lookup name
 load :: MonadEvaluatable location term value effects m
      => ModulePath
      -> m effects (Environment location value, value)
-load name = askModuleTable >>= maybeM notFound . ModuleTable.lookup name >>= evalAndCache
+load = loadWith evaluateModule
+
+loadWith :: MonadEvaluatable location term value effects m
+         => (Module term -> m effects value)
+         -> ModulePath
+         -> m effects (Environment location value, value)
+loadWith with name = askModuleTable >>= maybeM notFound . ModuleTable.lookup name >>= evalAndCache
   where
     notFound = throwLoadError (LoadError name)
 
@@ -222,7 +234,7 @@ load name = askModuleTable >>= maybeM notFound . ModuleTable.lookup name >>= eva
           pure (emptyEnv, v)
         else do
           modifyLoadStack (loadStackPush mPath)
-          v <- trace ("load (evaluating): " <> show mPath) $ evaluateModule x
+          v <- trace ("load (evaluating): " <> show mPath) $ with x
           modifyLoadStack loadStackPop
           traceM ("load done:" <> show mPath)
           env <- filterEnv <$> getExports <*> getEnv
@@ -238,12 +250,14 @@ load name = askModuleTable >>= maybeM notFound . ModuleTable.lookup name >>= eva
       | otherwise = Exports.toEnvironment ports `mergeEnvs` overwrite (Exports.aliases ports) env
 
 
--- | Evaluate a (root-level) term to a value using the semantics of the current analysis. This should be used to evaluate single-term programs, or (via 'evaluateModules') the entry point of multi-term programs.
-evaluateModule :: forall location term value effects m
-               .  MonadEvaluatable location term value effects m
-               => Module term
-               -> m effects value
-evaluateModule m = analyzeModule (subtermValue . moduleBody) (fmap (Subterm <*> evalTerm) m)
+-- | Evaluate a (root-level) term to a value using the semantics of the current analysis.
+evalModule :: forall location term value effects m
+           .  MonadEvaluatable location term value effects m
+           => Module term
+           -> m effects value
+evalModule m = raiseHandler
+  (interpose @(EvalModule term value) pure (\ (EvalModule m) yield -> lower @m (evalModule m) >>= yield))
+  (analyzeModule (subtermValue . moduleBody) (fmap (Subterm <*> evalTerm) m))
   where evalTerm term = catchReturn @m @value
           (raiseHandler
             (interpose @(EvalClosure term value) pure (\ (EvalClosure term) yield -> lower (evalTerm term) >>= yield))
@@ -264,9 +278,9 @@ evaluatePackageBody body = withPrelude (packagePrelude body) $
   localModuleTable (<> packageModules body) (traverse evaluateEntryPoint (ModuleTable.toPairs (packageEntryPoints body)))
   where
     evaluateEntryPoint (m, sym) = do
-      (_, v) <- require m
+      (_, v) <- requireWith evalModule m
       maybe (pure v) ((`call` []) <=< variable) sym
     withPrelude Nothing a = a
     withPrelude (Just prelude) a = do
-      preludeEnv <- evaluateModule prelude *> getEnv
+      preludeEnv <- evalModule prelude *> getEnv
       withDefaultEnvironment preludeEnv a