Store the environment in the linker instead of an Interface.Value

src/Analysis/Abstract/Evaluating.hs

@@ -29,7 +29,7 @@ type Evaluating v
      , State (EnvironmentFor v)      -- Global (imperative) environment
      , Reader (EnvironmentFor v)     -- Local environment (e.g. binding over a closure)
      , Reader (Linker (Evaluator v)) -- Linker effects
-     , State (Linker v)              -- Cache of evaluated modules
+     , State (Linker (EnvironmentFor v))              -- Cache of evaluated modules
      ]
 
 newtype Evaluator v = Evaluator { runEvaluator :: Eff (Evaluating v) v }
@@ -37,19 +37,20 @@ newtype Evaluator v = Evaluator { runEvaluator :: Eff (Evaluating v) v }
 -- | Require/import another term/file and return an Effect.
 --
 -- Looks up the term's name in the cache of evaluated modules first, returns a value if found, otherwise loads/evaluates the module.
-require :: forall v es. (Members (Evaluating v) es) => ModuleName -> Eff es v
-require name = get @(Linker v) >>= maybe (load name) pure . linkerLookup name
+require :: forall v es. (Members (Evaluating v) es, AbstractEnvironmentFor v) => ModuleName -> Eff es (EnvironmentFor v)
+require name = get @(Linker (EnvironmentFor v)) >>= maybe (load name) pure . linkerLookup name
 
 -- | Load another term/file and return an Effect.
 --
 -- Always loads/evaluates.
-load :: forall v es. (Members (Evaluating v) es) => ModuleName -> Eff es v
+load :: forall v es. (Members (Evaluating v) es, AbstractEnvironmentFor v) => ModuleName -> Eff es (EnvironmentFor v)
 load name = ask @(Linker (Evaluator v)) >>= maybe notFound evalAndCache . linkerLookup name
   where notFound = fail ("cannot find " <> show name)
         evalAndCache e = do
           v <- raiseEmbedded (runEvaluator e)
-          modify @(Linker v) (linkerInsert name v)
-          pure v
+          let env = environment v
+          modify @(Linker (EnvironmentFor v)) (linkerInsert name env)
+          pure env
 
 -- | Evaluate a term to a value.
 evaluate :: forall v term.

src/Data/Abstract/Value.hs

@@ -87,6 +87,15 @@ type family LocationFor value :: * where
   LocationFor Type.Type = Monovariant
 
 
+type AbstractEnvironmentFor v = AbstractEnvironment (LocationFor v) v
+class AbstractEnvironment l v | v -> l where
+  environment :: v -> EnvironmentFor v
+
+instance AbstractEnvironment l (Value l t) where
+  environment v
+    | Just (Interface _ env) <- prj v = env
+    | otherwise                       = mempty
+
 -- | Extract the value back out of a cell.
 class CellValue l v where
   val :: Cell l v -> v

src/Data/Syntax/Declaration.hs

@@ -15,7 +15,6 @@ import Diffing.Algorithm
 import Prelude hiding (fail)
 import Prologue
 import qualified Data.Abstract.Type as Type
-import qualified Data.Abstract.Value as Value
 import qualified Data.Map as Map
 
 data Function a = Function { functionContext :: ![a], functionName :: !a, functionParameters :: ![a], functionBody :: !a }
@@ -280,39 +279,38 @@ instance Eq1 Import2 where liftEq = genericLiftEq
 instance Ord1 Import2 where liftCompare = genericLiftCompare
 instance Show1 Import2 where liftShowsPrec = genericLiftShowsPrec
 
-instance ( Semigroup (Cell l (Value l t))
-         , Members (Evaluating (Value l t)) es
-         , Addressable l es
-         , Evaluatable es t (Value l t) (Base t)
+instance ( Members (Evaluating v) es
+         , Evaluatable es t v (Base t)
          , Recursive t
          , FreeVariables t
+         , AbstractValue v
+         , AbstractEnvironmentFor v
          )
-         => Evaluatable es t (Value l t) Import2 where
+         => Evaluatable es t v Import2 where
   eval (Import2 from alias xs) = do
     -- Capture current global environment
-    env <- get @(EnvironmentFor (Value l t))
+    env <- get @(EnvironmentFor v)
 
-    -- Evaluate the import, the interface value we get back will contain an
-    -- environment but evaluating will have also have potentially updated the
-    -- global environment.
-    interface <- require @(Value l t) (qualifiedName (subterm from))
-    (Interface _ modEnv) <- maybe (fail "expected an interface") pure (prj interface :: Maybe (Interface l t))
+    -- TODO: We may or may not want to clear the globalEnv before requiring.
+    put @(EnvironmentFor v) mempty
+
+    -- Evaluate the import to get it's environment.
+    -- (Evaluating will have also have potentially updated the global environment).
+    importedEnv <- require @v (qualifiedName (subterm from))
 
     -- Restore previous global environment, adding the imported env
     let symbols = Map.fromList xs
     let prefix = qualifiedName (subterm alias) <> "."
     env' <- Map.foldrWithKey (\k v rest -> do
       if Map.null symbols
+         -- Copy over all symbols in the environment under their qualified names.
         then envInsert (prefix <> k) v <$> rest
-        else case Map.lookup k symbols of
-          Just symAlias -> envInsert symAlias v <$> rest
-          Nothing -> rest
-      ) (pure env) (unEnvironment modEnv)
+        -- Only copy over specified symbols, possibly aliasing them.
+        else maybe rest (\symAlias -> envInsert symAlias v <$> rest) (Map.lookup k symbols)
+      ) (pure env) (unEnvironment importedEnv)
 
     modify (const env')
-    pure interface
-
-instance Member Fail es => Evaluatable es t Type.Type Import2
+    pure unit
 
 
 -- | A wildcard import
@@ -325,9 +323,13 @@ instance Show1 WildcardImport where liftShowsPrec = genericLiftShowsPrec
 
 instance ( Members (Evaluating v) es
          , FreeVariables t
+         , AbstractEnvironmentFor v
+         , AbstractValue v
          )
          => Evaluatable es t v WildcardImport where
-  eval (WildcardImport from _) = require @v (qualifiedName (subterm from))
+  eval (WildcardImport from _) = put @(EnvironmentFor v) mempty
+                               >> require @v (qualifiedName (subterm from))
+                               >> pure unit
 
 
 -- | An imported symbol