Store environment in state so we can modify it

src/Analysis/Abstract/Evaluating2.hs

@@ -28,6 +28,7 @@ type Evaluating v
   = '[ Fail                                   -- For 'MonadFail'.
      , State  (Store (LocationFor v) v)       -- For 'MonadStore'.
      -- , Reader (Environment (LocationFor v) v) -- For 'MonadEnv'.
+     , State  (Environment (LocationFor v) v)
      -- , Reader (Live (LocationFor v) v)        -- For 'MonadGC'.
      ]
 

src/Data/Abstract/Eval2.hs

@@ -7,8 +7,11 @@ module Data.Abstract.Eval2
 , Recursive(..)
 , Base
 , Recur(..)
+, Yield(..)
 ) where
 
+import Control.Monad.Effect.Reader
+import Control.Monad.Effect.State
 import Control.Monad.Effect.Env
 import Control.Monad.Effect.GC
 import Control.Monad.Fail
@@ -18,19 +21,41 @@ import Data.Abstract.Value
 import Data.Functor.Classes
 import Data.Proxy
 import Data.Term
+import Data.Monoid
 import Data.Union
 import Data.Functor.Foldable (Base, Recursive(..), project)
 import Prelude hiding (fail)
 import Control.Monad.Effect hiding (run)
 
 
+import Debug.Trace
+
+
+-- Yield with a modified environment
+class Yield v m where
+  getEnv :: m (Environment (LocationFor v) v)
+  yield :: (Environment (LocationFor v) v -> Environment (LocationFor v) v) -> v -> m v
+  yield' :: (Environment (LocationFor v) v -> Environment (LocationFor v) v) -> m v -> m v
+
+instance (State (Environment (LocationFor v) v) :< fs)
+         => Yield v (Eff fs) where
+  getEnv = get
+  -- yield f v = local f (pure v)
+  -- yield' f v = local f v
+  yield f v = get >>= put . f >> pure v
+  yield' f v = get >>= put . f >> v
+
+-- | Recurse and evaluate a term
 class Recur term v m where
   recur :: term -> m v
+  recur' :: (Environment (LocationFor v) v -> Environment (LocationFor v) v) -> term -> m v
 
 instance ( Eval term v (Eff fs) (Base term)
+         , State (Environment (LocationFor v) v) :< fs
          , Recursive term )
          => Recur term v (Eff fs) where
   recur = eval . project
+  recur' f term = get >>= put . f >> recur term
 
 
 -- | The 'Eval' class defines the necessary interface for a term to be evaluated. While a default definition of 'eval' is given, instances with computational content must implement 'eval' to perform their small-step operational semantics.
@@ -61,14 +86,28 @@ instance ( Monad m
          -- , MonadEnv v m
          , AbstractValue v
          , Recursive t
-         -- , FreeVariables t
+         , FreeVariables t
          , Recur t v m
+         , Yield v m
          , Eval t v m (Base t)
+
+         , Show (LocationFor v)
          )
          => Eval t v m [] where
   eval []     = pure unit
   eval [x]    = recur x
-  eval (x:xs) = recur @t @v x >> eval xs
+  eval (x:xs) = recur' @t @v ((bindEnv (freeVariables1 xs))) x >> eval xs
+  
+  -- eval (x:xs) = do
+    -- env <- askEnv :: m (Environment (LocationFor v) v)
+    -- recur' @t @v (bindEnv (freeVariables1 xs)) x >> eval xs
+  -- eval [x]    = recur' id x
+  -- eval (x:xs) = recur @t @v x >> eval xs
+  -- eval (x:xs) = do
+  --   recur' @t @v ((bindEnv (freeVariables1 xs))) x >> eval xs
+    -- yield' (bindEnv (freeVariables1 xs)) (recur @t @v x >> eval xs)
+    -- recur @t @v x >> yield' (bindEnv (freeVariables1 xs)) (eval xs)
+
 
   -- eval (x:xs) = eval (project x) >>= \_ -> eval xs
   -- eval ev yield [a]    = ev pure a >>= yield

src/Data/Syntax.hs

@@ -139,6 +139,15 @@ instance ( MonadAddress (LocationFor v) m
     env <- askEnv
     maybe (fail ("free variable: " <> unpack name)) deref (envLookup name env) >>= yield
 
+instance ( MonadAddress (LocationFor v) m
+         -- , MonadEnv v m
+         , MonadFail m
+         , MonadStore v m
+         , E2.Yield v m
+         ) => E2.Eval t v m Identifier where
+  eval (Identifier name) = do
+    env <- E2.getEnv
+    maybe (fail ("free variable: " <> unpack name)) deref (envLookup name env)
 
 instance FreeVariables1 Identifier where
   liftFreeVariables _ (Identifier x) = point x
@@ -184,11 +193,17 @@ instance ( Monad m
   eval ev yield (Program xs) = eval ev yield xs
 
 instance ( MonadFail m
+         -- , MonadEnv v m
          , Ord (LocationFor v)
          , AbstractValue v
          , E2.Recursive t
          , E2.Eval t v m (E2.Base t)
+          -- for [] instance of Eval
          , E2.Recur t v m
+         , FreeVariables t
+         , E2.Yield v m
+
+         , Show (LocationFor v)
          )
          => E2.Eval t v m Program where
   eval (Program xs) = E2.eval xs

src/Data/Syntax/Declaration.hs

@@ -10,6 +10,7 @@ import Data.Abstract.Address
 import Data.Abstract.Environment
 import Analysis.Abstract.Evaluating
 import Data.Abstract.Eval
+import qualified Data.Abstract.Eval2 as E2
 import Data.Abstract.FreeVariables
 import Data.Abstract.Type hiding (Type)
 import qualified Data.Abstract.Value as Value
@@ -97,6 +98,26 @@ instance Show1 Method where liftShowsPrec = genericLiftShowsPrec
 -- TODO: Implement Eval instance for Method
 instance (MonadFail m) => Eval t v m Method
 
+-- Evaluating a Function creates a closure and makes that value available in the
+-- local environment.
+instance ( Monad m
+         -- , MonadEnv (Value l t) m         -- 'askEnv'
+         , FreeVariables t                -- To get free variables from the function's parameters
+         , Semigroup (Cell l (Value l t)) -- envLookupOrAlloc'
+         , MonadStore (Value l t) m       -- envLookupOrAlloc'
+         , MonadAddress l m               -- envLookupOrAlloc'
+         , E2.Yield (Value l t) m         -- 'yield'
+         ) => E2.Eval t (Value l t) m Method where
+  eval Method{..} = do
+    env <- E2.getEnv @(Value l t)
+    let params = toList (foldMap freeVariables methodParameters)
+    let v = inj (Closure params methodBody env) :: Value l t
+    (name, addr) <- envLookupOrAlloc' methodName env v
+    E2.yield (envInsert name addr) v
+    -- localEnv (envInsert name a) (yield v)
+
+instance ( MonadFail m
+         ) => E2.Eval t Type.Type m Method
 
 -- | A method signature in TypeScript or a method spec in Go.
 data MethodSignature a = MethodSignature { _methodSignatureContext :: ![a], _methodSignatureName :: !a, _methodSignatureParameters :: ![a] }
@@ -284,6 +305,8 @@ instance ( Monad m
 
 instance MonadFail m => Eval t Type.Type m Import
 
+instance (MonadFail m) => E2.Eval t v m Import
+
 -- | An imported symbol
 data ImportSymbol a = ImportSymbol { importSymbolName :: !a, importSymbolAlias :: !a }
   deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)