Modify the load stack locally.

src/Analysis/Abstract/Evaluating.hs

@@ -6,6 +6,7 @@ module Analysis.Abstract.Evaluating
 import Control.Abstract.Analysis
 import qualified Control.Monad.Effect as Eff
 import Data.Abstract.Environment
+import Data.Abstract.ModuleTable
 import Data.Abstract.Origin
 import Data.Semilattice.Lower
 import Prologue
@@ -25,10 +26,12 @@ type EvaluatingEffects location term value
      , Fresh                                       -- For allocating new addresses and/or type variables.
      , Reader (SomeOrigin term)                    -- The current term’s origin.
      , Reader (Environment location value)         -- Default environment used as a fallback in lookupEnv
+     , Reader LoadStack
      , State  (EvaluatorState location term value) -- Environment, heap, modules, exports, and jumps.
      ]
 
 instance ( Member (Reader (Environment location value)) effects
+         , Member (Reader LoadStack) effects
          , Member (Reader (SomeOrigin term)) effects
          , Member (State (EvaluatorState location term value)) effects
          )
@@ -36,6 +39,7 @@ instance ( Member (Reader (Environment location value)) effects
 
 instance ( Corecursive term
          , Member (Reader (Environment location value)) effects
+         , Member (Reader LoadStack) effects
          , Member (Reader (SomeOrigin term)) effects
          , Member (State (EvaluatorState location term value)) effects
          , Recursive term
@@ -55,6 +59,7 @@ instance (AbstractHole value, Show term, Show value) => Interpreter (Evaluating
     . runEvaluating
     . raiseHandler
       ( flip runState  lowerBound -- State (EvaluatorState location term value)
+      . flip runReader lowerBound -- Reader LoadStack
       . flip runReader lowerBound -- Reader (Environment location value)
       . flip runReader lowerBound -- Reader (SomeOrigin term)
       . flip runFresh' 0

src/Control/Abstract/Evaluator.hs

@@ -37,9 +37,8 @@ module Control.Abstract.Evaluator
   , getModuleTable
   , putModuleTable
   , modifyModuleTable
-  , getLoadStack
-  , putLoadStack
-  , modifyLoadStack
+  , askLoadStack
+  , localLoadStack
   , currentModule
   , currentPackage
   -- * Control
@@ -93,6 +92,7 @@ import Prologue
 --   - tables of modules available for import
 class ( Effectful m
       , Member (Reader (Environment location value)) effects
+      , Member (Reader LoadStack) effects
       , Member (Reader (SomeOrigin term)) effects
       , Member (State (EvaluatorState location term value)) effects
       , Monad (m effects)
@@ -106,7 +106,6 @@ data EvaluatorState location term value = EvaluatorState
   { environment :: Environment location value
   , heap        :: Heap location value
   , modules     :: ModuleTable (Environment location value, value)
-  , loadStack   :: LoadStack
   , exports     :: Exports location value
   , jumps       :: IntMap.IntMap (SomeOrigin term, term)
   }
@@ -116,7 +115,7 @@ deriving instance (Ord (Cell location value), Ord location, Ord term, Ord value,
 deriving instance (Show (Cell location value), Show location, Show term, Show value, Show (Base term ())) => Show (EvaluatorState location term value)
 
 instance Lower (EvaluatorState location term value) where
-  lowerBound = EvaluatorState lowerBound lowerBound lowerBound lowerBound lowerBound lowerBound
+  lowerBound = EvaluatorState lowerBound lowerBound lowerBound lowerBound lowerBound
 
 
 -- Lenses
@@ -130,9 +129,6 @@ _heap = lens heap (\ s h -> s {heap = h})
 _modules :: Lens' (EvaluatorState location term value) (ModuleTable (Environment location value, value))
 _modules = lens modules (\ s m -> s {modules = m})
 
-_loadStack :: Lens' (EvaluatorState location term value) LoadStack
-_loadStack = lens loadStack (\ s l -> s {loadStack = l})
-
 _exports :: Lens' (EvaluatorState location term value) (Exports location value)
 _exports = lens exports (\ s e -> s {exports = e})
 
@@ -307,18 +303,12 @@ modifyModuleTable f = do
 
 
 -- | Retrieve the module load stack
-getLoadStack :: MonadEvaluator location term value effects m => m effects LoadStack
-getLoadStack = view _loadStack
+askLoadStack :: MonadEvaluator location term value effects m => m effects LoadStack
+askLoadStack = raise ask
 
--- | Set the module load stack
-putLoadStack :: MonadEvaluator location term value effects m => LoadStack -> m effects ()
-putLoadStack = (_loadStack .=)
-
--- | Update the module load stack.
-modifyLoadStack :: MonadEvaluator location term value effects m => (LoadStack -> LoadStack) -> m effects ()
-modifyLoadStack f = do
-  stack <- getLoadStack
-  putLoadStack $! f stack
+-- | Locally update the module load stack.
+localLoadStack :: MonadEvaluator location term value effects m => (LoadStack -> LoadStack) -> m effects a -> m effects a
+localLoadStack = raiseHandler . local
 
 
 -- | Get the currently evaluating 'ModuleInfo'.

src/Data/Abstract/Evaluatable.hs

@@ -252,13 +252,11 @@ loadWith with name = askModuleTable >>= maybeM notFound . ModuleTable.lookup nam
 
     evalAndCache x = do
       let mPath = modulePath (moduleInfo x)
-      LoadStack{..} <- getLoadStack
+      LoadStack{..} <- askLoadStack
       if mPath `elem` unLoadStack
         then trace ("load (skip evaluating, circular load): " <> show mPath) (pure Nothing)
         else do
-          modifyLoadStack (loadStackPush mPath)
-          v <- trace ("load (evaluating): " <> show mPath) $ with x
-          modifyLoadStack loadStackPop
+          v <- localLoadStack (loadStackPush mPath) (trace ("load (evaluating): " <> show mPath) (with x))
           traceM ("load done:" <> show mPath)
           env <- filterEnv <$> getExports <*> getEnv
           modifyModuleTable (ModuleTable.insert name (env, v))