From 15b073485e9cb4b977a777b0bf482a196f4d685b Mon Sep 17 00:00:00 2001
From: joshvera <josh@joshvera.com>
Date: Wed, 7 Mar 2018 10:03:45 -0500
Subject: [PATCH] Add addExport and getExports to MonadEvaluator

---
 src/Analysis/Abstract/Dead.hs       |  1 +
 src/Analysis/Abstract/Evaluating.hs |  1 +
 src/Control/Abstract/Evaluator.hs   | 12 +++++++++++-
 src/Control/Abstract/Value.hs       |  4 +++-
 4 files changed, 16 insertions(+), 2 deletions(-)

diff --git a/src/Analysis/Abstract/Dead.hs b/src/Analysis/Abstract/Dead.hs
index cb2070377..f3627abc8 100644
--- a/src/Analysis/Abstract/Dead.hs
+++ b/src/Analysis/Abstract/Dead.hs
@@ -20,6 +20,7 @@ type DeadCodeEffects t v
   = '[ State (Dead t)                  -- The set of dead terms
      , Fail                            -- Failure with an error message
      , State (Store (LocationFor v) v) -- The heap
+     , State (Set (Name, Name))                -- Set of exports
      , State (EnvironmentFor v)        -- Global (imperative) environment
      , Reader (EnvironmentFor v)       -- Local environment (e.g. binding over a closure)
      , Reader (Linker t)               -- Cache of unevaluated modules
diff --git a/src/Analysis/Abstract/Evaluating.hs b/src/Analysis/Abstract/Evaluating.hs
index 466ed2c6d..b92daceaa 100644
--- a/src/Analysis/Abstract/Evaluating.hs
+++ b/src/Analysis/Abstract/Evaluating.hs
@@ -25,6 +25,7 @@ type EvaluationEffects t v
   = '[ Fail                              -- Failure with an error message
      , State (Store (LocationFor v) v)   -- The heap
      , State (EnvironmentFor v)          -- Global (imperative) environment
+     , State (Set (Name, Name))                -- Set of exports
      , Reader (EnvironmentFor v)         -- Local environment (e.g. binding over a closure)
      , Reader (Linker t)                 -- Cache of unevaluated modules
      , State (Linker (EnvironmentFor v)) -- Cache of evaluated modules
diff --git a/src/Control/Abstract/Evaluator.hs b/src/Control/Abstract/Evaluator.hs
index eb5427d30..575bbeec9 100644
--- a/src/Control/Abstract/Evaluator.hs
+++ b/src/Control/Abstract/Evaluator.hs
@@ -1,7 +1,7 @@
 {-# LANGUAGE DataKinds, FunctionalDependencies, GeneralizedNewtypeDeriving, RankNTypes, StandaloneDeriving, UndecidableInstances #-}
 module Control.Abstract.Evaluator where
 
-import Control.Applicative
+import Prologue
 import Control.Monad.Effect
 import Control.Monad.Effect.Fail
 import Control.Monad.Effect.Fresh
@@ -9,6 +9,8 @@ import Control.Monad.Effect.NonDetEff
 import Control.Monad.Effect.Reader
 import Control.Monad.Effect.State
 import Data.Abstract.Linker
+import Data.Abstract.FreeVariables (Name)
+import Data.Set as Set
 import Data.Abstract.Value
 import Prelude hiding (fail)
 
@@ -26,6 +28,10 @@ class MonadFail m => MonadEvaluator term value m | m -> term, m -> value where
   -- | Update the global environment.
   modifyGlobalEnv :: (EnvironmentFor value -> EnvironmentFor value) -> m ()
 
+  -- | Scope the set of exported symbols to the global environment
+  addExport :: (Name, Name) -> m ()
+  getExports :: m (Set (Name, Name))
+
   -- | Retrieve the local environment.
   askLocalEnv :: m (EnvironmentFor value)
   -- | Run an action with a locally-modified environment.
@@ -48,6 +54,7 @@ class MonadFail m => MonadEvaluator term value m | m -> term, m -> value where
 
 instance Members '[ Fail
                   , Reader (EnvironmentFor value)
+                  , State  (Set (Name, Name))
                   , State  (EnvironmentFor value)
                   , State  (StoreFor value)
                   , Reader (Linker term)
@@ -58,6 +65,9 @@ instance Members '[ Fail
   putGlobalEnv = Evaluator . put
   modifyGlobalEnv f = Evaluator (modify f)
 
+  addExport = Evaluator . modify . Set.insert
+  getExports = Evaluator get
+
   askLocalEnv = Evaluator ask
   localEnv f a = Evaluator (local f (runEvaluator a))
 
diff --git a/src/Control/Abstract/Value.hs b/src/Control/Abstract/Value.hs
index ef0f2e71e..b4282da0e 100644
--- a/src/Control/Abstract/Value.hs
+++ b/src/Control/Abstract/Value.hs
@@ -57,7 +57,9 @@ instance ( FreeVariables t
   integer = pure . inj . Integer
   boolean = pure . inj . Boolean
   string  = pure . inj . Value.String
-  interface v = inj . Value.Interface v <$> getGlobalEnv
+  interface v = inj . Value.Interface v <$> prunedEnv
+    where
+      prunedEnv = bindExports <$> getExports <*> getGlobalEnv
 
   ifthenelse cond if' else'
     | Just (Boolean b) <- prj cond = if b then if' else else'