Run the environment state in evaluatePackageWith.

src/Control/Abstract/Modules.hs

@@ -23,6 +23,7 @@ import Data.Abstract.Environment
 import Data.Abstract.Module
 import Data.Abstract.ModuleTable as ModuleTable
 import Data.Language
+import Data.Tuple (swap)
 import Prologue
 
 -- | Retrieve an evaluated module, if any. The outer 'Maybe' indicates whether we’ve begun loading the module or not, while the inner 'Maybe' indicates whether we’ve completed loading it or not. Thus, @Nothing@ means we’ve never tried to load it, @Just Nothing@ means we’ve started but haven’t yet finished loading it, and @Just (Just (env, value))@ indicates the result of a completed load.
@@ -47,11 +48,11 @@ require path = lookupModule path >>= maybeM (load path)
 --
 -- Always loads/evaluates.
 load :: Member (Modules address value) effects => ModulePath -> Evaluator address value effects (Maybe (Environment address, value))
-load = send . Load
+load path = fmap swap <$> send (Load path)
 
 
 data Modules address value return where
-  Load    :: ModulePath -> Modules address value (Maybe (Environment address, value))
+  Load    :: ModulePath -> Modules address value (Maybe (value, Environment address))
   Lookup  :: ModulePath -> Modules address value (Maybe (Maybe (Environment address, value)))
   Resolve :: [FilePath] -> Modules address value (Maybe ModulePath)
   List    :: FilePath   -> Modules address value [ModulePath]
@@ -64,7 +65,7 @@ runModules :: forall term address value effects a
               , Member (State (ModuleTable (Maybe (Environment address, value)))) effects
               , Member Trace effects
               )
-           => (Module term -> Evaluator address value (Modules address value ': effects) (Environment address, value))
+           => (Module term -> Evaluator address value (Modules address value ': effects) (value, Environment address))
            -> Evaluator address value (Modules address value ': effects) a
            -> Evaluator address value (Reader (ModuleTable [Module term]) ': effects) a
 runModules evaluateModule = go
@@ -92,19 +93,19 @@ runModules evaluateModule = go
 getModuleTable :: Member (State (ModuleTable (Maybe (Environment address, value)))) effects => Evaluator address value effects (ModuleTable (Maybe (Environment address, value)))
 getModuleTable = get
 
-cacheModule :: Member (State (ModuleTable (Maybe (Environment address, value)))) effects => ModulePath -> Maybe (Environment address, value) -> Evaluator address value effects (Maybe (Environment address, value))
-cacheModule path result = modify' (ModuleTable.insert path result) $> result
+cacheModule :: Member (State (ModuleTable (Maybe (Environment address, value)))) effects => ModulePath -> Maybe (value, Environment address) -> Evaluator address value effects (Maybe (value, Environment address))
+cacheModule path result = modify' (ModuleTable.insert path (swap <$> result)) $> result
 
 askModuleTable :: Member (Reader (ModuleTable [Module term])) effects => Evaluator address value effects (ModuleTable [Module term])
 askModuleTable = ask
 
 
-newtype Merging m address value = Merging { runMerging :: m (Maybe (Environment address, value)) }
+newtype Merging m address value = Merging { runMerging :: m (Maybe (value, Environment address)) }
 
 instance Applicative m => Semigroup (Merging m address value) where
   Merging a <> Merging b = Merging (merge <$> a <*> b)
     where merge a b = mergeJusts <$> a <*> b <|> a <|> b
-          mergeJusts (env1, _) (env2, v) = (mergeEnvs env1 env2, v)
+          mergeJusts (_, env1) (v, env2) = (v, mergeEnvs env1 env2)
 
 instance Applicative m => Monoid (Merging m address value) where
   mappend = (<>)
@@ -113,7 +114,7 @@ instance Applicative m => Monoid (Merging m address value) where
 
 -- | An error thrown when loading a module from the list of provided modules. Indicates we weren't able to find a module with the given name.
 data LoadError address value resume where
-  ModuleNotFound :: ModulePath -> LoadError address value (Maybe (Environment address, value))
+  ModuleNotFound :: ModulePath -> LoadError address value (Maybe (value, Environment address))
 
 deriving instance Eq (LoadError address value resume)
 deriving instance Show (LoadError address value resume)
@@ -122,7 +123,7 @@ instance Show1 (LoadError address value) where
 instance Eq1 (LoadError address value) where
   liftEq _ (ModuleNotFound a) (ModuleNotFound b) = a == b
 
-moduleNotFound :: Member (Resumable (LoadError address value)) effects => ModulePath -> Evaluator address value effects (Maybe (Environment address, value))
+moduleNotFound :: Member (Resumable (LoadError address value)) effects => ModulePath -> Evaluator address value effects (Maybe (value, Environment address))
 moduleNotFound = throwResumable . ModuleNotFound
 
 resumeLoadError :: Member (Resumable (LoadError address value)) effects => Evaluator address value effects a -> (forall resume . LoadError address value resume -> Evaluator address value effects resume) -> Evaluator address value effects a

src/Data/Abstract/Evaluatable.hs

@@ -85,7 +85,6 @@ evaluatePackageWith :: forall address term value inner inner' inner'' outer
                        , Member Fresh outer
                        , Member (Resumable (AddressError address value)) outer
                        , Member (Resumable (LoadError address value)) outer
-                       , Member (State (Environment address)) outer
                        , Member (State (Exports address)) outer
                        , Member (State (Heap address (Cell address) value)) outer
                        , Member (State (ModuleTable (Maybe (Environment address, value)))) outer
@@ -98,7 +97,7 @@ evaluatePackageWith :: forall address term value inner inner' inner'' outer
                     => (SubtermAlgebra Module      term (TermEvaluator term address value inner value)            -> SubtermAlgebra Module      term (TermEvaluator term address value inner value))
                     -> (SubtermAlgebra (Base term) term (TermEvaluator term address value inner (ValueRef value)) -> SubtermAlgebra (Base term) term (TermEvaluator term address value inner (ValueRef value)))
                     -> Package term
-                    -> TermEvaluator term address value outer [value]
+                    -> TermEvaluator term address value outer [(value, Environment address)]
 evaluatePackageWith analyzeModule analyzeTerm package
   = runReader (packageInfo package)
   . runReader lowerBound
@@ -119,22 +118,22 @@ evaluatePackageWith analyzeModule analyzeTerm package
         runInModule preludeEnv info
           = runReader info
           . raiseHandler runAllocator
-          . raiseHandler (runEnv preludeEnv)
+          . raiseHandler (runEnvState preludeEnv)
           . raiseHandler runReturn
           . raiseHandler runLoopControl
 
-        evaluateEntryPoint :: Environment address -> ModulePath -> Maybe Name -> TermEvaluator term address value inner'' value
+        evaluateEntryPoint :: Environment address -> ModulePath -> Maybe Name -> TermEvaluator term address value inner'' (value, Environment address)
         evaluateEntryPoint preludeEnv m sym = runInModule preludeEnv (ModuleInfo m) . TermEvaluator $ do
           v <- maybe unit snd <$> require m
           maybe (pure v) ((`call` []) <=< variable) sym
 
         evalPrelude prelude = raiseHandler (runModules (runTermEvaluator . evalModule emptyEnv)) $ do
           _ <- runInModule emptyEnv moduleInfoFromCallStack (TermEvaluator (defineBuiltins $> unit))
-          fst <$> evalModule emptyEnv prelude
+          evalModule emptyEnv prelude
 
         withPrelude Nothing f = f emptyEnv
         withPrelude (Just prelude) f = do
-          preludeEnv <- evalPrelude prelude
+          (_, preludeEnv) <- evalPrelude prelude
           f preludeEnv
 
         -- TODO: If the set of exports is empty because no exports have been
@@ -143,7 +142,10 @@ evaluatePackageWith analyzeModule analyzeTerm package
         filterEnv ports env
           | Exports.null ports = env
           | otherwise          = Exports.toEnvironment ports `mergeEnvs` overwrite (Exports.aliases ports) env
-        pairValueWithEnv action = flip (,) <$> action <*> (filterEnv <$> TermEvaluator getExports <*> TermEvaluator (get @(Environment address)))
+        pairValueWithEnv action = do
+          (a, env) <- action
+          filtered <- filterEnv <$> TermEvaluator getExports <*> pure env
+          pure (a, filtered)
 
 
 -- | Isolate the given action with an empty global environment and exports.