thread default environments properly throughout the stack

semantic.cabal

@@ -108,6 +108,7 @@ library
                      , Language.PHP.Assignment
                      , Language.PHP.Grammar
                      , Language.PHP.Syntax
+                     , Language.Preluded
                      , Language.Python.Assignment
                      , Language.Python.Grammar
                      , Language.Python.Syntax

src/Analysis/Abstract/Evaluating.hs

@@ -53,8 +53,14 @@ evaluateWith :: forall value term effects
          -> term
          -> Final effects value
 evaluateWith prelude t = runAnalysis @(Evaluating term value) $ do
-  preludeEnv <- evaluateModule prelude *> getEnv
-  withEnv preludeEnv (evaluateModule t)
+  -- evaluateTerm here rather than evaluateModule
+  -- TODO: we could add evaluatePrelude to MonadAnalysis as an alias for evaluateModule,
+  -- overridden in Evaluating to not reset the environment. In the future we'll want the
+  -- result of evaluating the Prelude to be a build artifact, rather than something that's
+  -- evaluated every single time, but that's contingent upon a whole lot of other future
+  -- scaffolding.
+  preludeEnv <- evaluateTerm prelude *> getEnv
+  withDefaultEnvironment preludeEnv (evaluateModule t)
 
 -- | Evaluate terms and an entry point to a value.
 evaluates :: forall value term effects
@@ -99,6 +105,7 @@ type EvaluatingEffects term value
      , State  (EnvironmentFor value)               -- Environments (both local and global)
      , State  (HeapFor value)                      -- The heap
      , Reader (ModuleTable [term])                 -- Cache of unevaluated modules
+     , Reader (EnvironmentFor value)               -- Default environment used by evaluateModule
      , State  (ModuleTable (EnvironmentFor value)) -- Cache of evaluated modules
      , State  (ExportsFor value)                   -- Exports (used to filter environments when they are imported)
      , State  (IntMap.IntMap term)                 -- For jumps
@@ -113,11 +120,17 @@ instance Members '[Fail, State (IntMap.IntMap term)] effects => MonadControl ter
 
   goto label = IntMap.lookup label <$> raise get >>= maybe (fail ("unknown label: " <> show label)) pure
 
-instance Members '[State (ExportsFor value), State (EnvironmentFor value)] effects => MonadEnvironment value (Evaluating term value effects) where
+instance Members '[ State (ExportsFor value)
+                  , State (EnvironmentFor value)
+                  , Reader (EnvironmentFor value)
+                  ] effects => MonadEnvironment value (Evaluating term value effects) where
   getEnv = raise get
   putEnv = raise . put
   withEnv s = raise . localState s . lower
 
+  defaultEnvironment = raise ask
+  withDefaultEnvironment e = raise . local (const e) . lower
+
   getExports = raise get
   putExports = raise . put
   withExports s = raise . localState s . lower
@@ -152,4 +165,8 @@ instance ( Evaluatable (Base term)
          => MonadAnalysis term value (Evaluating term value effects) where
   type RequiredEffects term value (Evaluating term value effects) = EvaluatingEffects term value
 
+  evaluateModule t = do
+    def <- defaultEnvironment
+    withEnv def (evaluateTerm t)
+
   analyzeTerm = eval

src/Control/Abstract/Evaluator.hs

@@ -52,6 +52,12 @@ class Monad m => MonadEnvironment value m | m -> value where
   -- | Sets the environment for the lifetime of the given action.
   withEnv :: EnvironmentFor value -> m a -> m a
 
+  -- | Retrieve the default environment.
+  defaultEnvironment :: m (EnvironmentFor value)
+
+  -- | Set the default environment for the lifetime of an action
+  withDefaultEnvironment :: EnvironmentFor value -> m a -> m a
+
   -- | Get the global export state.
   getExports :: m (ExportsFor value)
   -- | Set the global export state.

src/Language/Preluded.hs

@@ -0,0 +1,17 @@
+module Language.Preluded
+    ( Preluded (..)
+    , export
+    ) where
+
+import GHC.TypeLits
+import qualified Language.Python.Assignment as Python
+import qualified Language.Ruby.Assignment as Ruby
+
+class Preluded syntax where
+  type PreludePath syntax :: Symbol
+
+instance Preluded Ruby.Term where
+  type PreludePath Ruby.Term = "preludes/ruby.rb"
+
+instance Preluded Python.Term where
+  type PreludePath Python.Term = "preludes/python.py"

src/Semantic/Util.hs

@@ -23,6 +23,7 @@ import Data.Term
 import Diffing.Algorithm
 import Diffing.Interpreter
 import qualified GHC.TypeLits as TypeLevel
+import Language.Preluded
 import Parsing.Parser
 import Prologue
 import Semantic
@@ -35,8 +36,7 @@ import qualified Language.TypeScript.Assignment as TypeScript
 import qualified Language.Ruby.Assignment as Ruby
 
 -- Ruby
-evaluateRubyFile = evaluateFile rubyParser
-evaluatePreludedRubyFile = evaluateWithPrelude rubyParser
+evaluateRubyFile = evaluateWithPrelude rubyParser
 evaluateRubyFiles = evaluateFiles rubyParser
 
 -- Go
@@ -45,7 +45,7 @@ evaluateGoFiles = evaluateFiles goParser
 typecheckGoFile path = runAnalysis @(Caching Evaluating Go.Term Type) . evaluateModule . snd <$> parseFile goParser path
 
 -- Python
-evaluatePythonFile = evaluateFile pythonParser
+evaluatePythonFile = evaluateWithPrelude pythonParser
 evaluatePythonFiles = evaluateFiles pythonParser
 typecheckPythonFile path = runAnalysis @(Caching Evaluating Python.Term Type) . evaluateModule . snd <$> parseFile pythonParser path
 tracePythonFile path = runAnalysis @(Tracing [] Evaluating Python.Term Value) . evaluateModule . snd <$> parseFile pythonParser path
@@ -56,15 +56,6 @@ typecheckTypeScriptFile path = runAnalysis @(Caching Evaluating TypeScript.Term
 evaluateTypeScriptFile = evaluateFile typescriptParser
 evaluateTypeScriptFiles = evaluateFiles typescriptParser
 
-class HasPreludePath syntax where
-  type PreludePath syntax :: TypeLevel.Symbol
-
-instance HasPreludePath Ruby.Term where
-  type PreludePath Ruby.Term = "preludes/ruby.rb"
-
-instance HasPreludePath Python.Term where
-  type PreludePath Python.Term = "preludes/python.py"
-
 -- Evalute a single file.
 evaluateFile :: forall term effects
              .  ( Evaluatable (Base term)