From d9084f9f451e9e7237df8f313774207652ee12cc Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Tue, 8 May 2018 10:54:04 -0400
Subject: [PATCH] lambda takes the set of free variables as a parameter.

---
 src/Control/Abstract/Value.hs           | 7 +++++--
 src/Data/Abstract/Type.hs               | 2 +-
 src/Data/Abstract/Value.hs              | 6 +++---
 src/Data/Syntax/Declaration.hs          | 5 +++--
 test/Control/Abstract/Evaluator/Spec.hs | 5 +----
 5 files changed, 13 insertions(+), 12 deletions(-)

diff --git a/src/Control/Abstract/Value.hs b/src/Control/Abstract/Value.hs
index 5e5618f9a..680eb2c56 100644
--- a/src/Control/Abstract/Value.hs
+++ b/src/Control/Abstract/Value.hs
@@ -137,8 +137,11 @@ class Show value => AbstractValue location value effects where
   -- | Extract the environment from any scoped object (e.g. classes, namespaces, etc).
   scopedEnvironment :: value -> Evaluator location term value effects (Maybe (Environment location value))
 
-  -- | Evaluate an abstraction (a binder like a lambda or method definition).
-  lambda :: FreeVariables term => [Name] -> Subterm term (Evaluator location term value effects value) -> Evaluator location term value effects value
+  -- | Build a closure (a binder like a lambda or method definition).
+  lambda :: [Name]                                      -- ^ The parameter names.
+         -> Set Name                                    -- ^ The set of free variables to close over.
+         -> Evaluator location term value effects value -- ^ The evaluator for the body of the closure.
+         -> Evaluator location term value effects value
   -- | Evaluate an application (like a function call).
   call :: value -> [Evaluator location term value effects value] -> Evaluator location term value effects value
 
diff --git a/src/Data/Abstract/Type.hs b/src/Data/Abstract/Type.hs
index 9269aa382..5f174dfa5 100644
--- a/src/Data/Abstract/Type.hs
+++ b/src/Data/Abstract/Type.hs
@@ -92,7 +92,7 @@ instance ( Addressable location effects
          , Reducer (Type location) (Cell location (Type location))
          )
       => AbstractValue location (Type location) effects where
-  lambda names (Subterm _ body) = do
+  lambda names _ body = do
     (env, tvars) <- foldr (\ name rest -> do
       a <- alloc name
       tvar <- Var <$> raise fresh
diff --git a/src/Data/Abstract/Value.hs b/src/Data/Abstract/Value.hs
index d9b252276..1244d7be4 100644
--- a/src/Data/Abstract/Value.hs
+++ b/src/Data/Abstract/Value.hs
@@ -349,9 +349,9 @@ instance ( Addressable location (Goto effects (Value location) ': effects)
     | otherwise = throwValueError (Bitwise2Error left right)
       where pair = (left, right)
 
-  lambda names (Subterm body bodyValue) = do
-    l <- label bodyValue
-    injValue . Closure names l . Env.bind (foldr Set.delete (Set.fromList (freeVariables body)) names) <$> getEnv
+  lambda parameters freeVariables body = do
+    l <- label body
+    injValue . Closure parameters l . Env.bind (foldr Set.delete freeVariables parameters) <$> getEnv
 
   call op params = do
     case prjValue op of
diff --git a/src/Data/Syntax/Declaration.hs b/src/Data/Syntax/Declaration.hs
index bbbfedfd9..c10890361 100644
--- a/src/Data/Syntax/Declaration.hs
+++ b/src/Data/Syntax/Declaration.hs
@@ -3,6 +3,7 @@ module Data.Syntax.Declaration where
 
 import qualified Data.Abstract.Environment as Env
 import Data.Abstract.Evaluatable
+import qualified Data.Set as Set (fromList)
 import Diffing.Algorithm
 import Prologue
 
@@ -22,7 +23,7 @@ instance Show1 Function where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable Function where
   eval Function{..} = do
     name <- either (throwEvalError . FreeVariablesError) pure (freeVariable $ subterm functionName)
-    (v, addr) <- letrec name (lambda (paramNames functionParameters) functionBody)
+    (v, addr) <- letrec name (lambda (paramNames functionParameters) (Set.fromList (freeVariables functionBody)) (subtermValue functionBody))
     modifyEnv (Env.insert name addr)
     pure v
     where paramNames = foldMap (freeVariables . subterm)
@@ -46,7 +47,7 @@ instance Show1 Method where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable Method where
   eval Method{..} = do
     name <- either (throwEvalError . FreeVariablesError) pure (freeVariable $ subterm methodName)
-    (v, addr) <- letrec name (lambda (paramNames methodParameters) methodBody)
+    (v, addr) <- letrec name (lambda (paramNames methodParameters) (Set.fromList (freeVariables methodBody)) (subtermValue methodBody))
     modifyEnv (Env.insert name addr)
     pure v
     where paramNames = foldMap (freeVariables . subterm)
diff --git a/test/Control/Abstract/Evaluator/Spec.hs b/test/Control/Abstract/Evaluator/Spec.hs
index bfed43c69..66fd89180 100644
--- a/test/Control/Abstract/Evaluator/Spec.hs
+++ b/test/Control/Abstract/Evaluator/Spec.hs
@@ -22,7 +22,7 @@ spec = parallel $ do
 
   it "calls functions" $ do
     (expected, _) <- evaluate $ do
-      identity <- lambda [name "x"] (term (variable (name "x")))
+      identity <- lambda [name "x"] lowerBound (variable (name "x"))
       call identity [integer 123]
     expected `shouldBe` Right (Value.injValue (Value.Integer (Number.Integer 123)))
 
@@ -47,9 +47,6 @@ reassociate :: Either String (Either (SomeExc exc1) (Either (SomeExc exc2) (Eith
 reassociate (Left s) = Left (SomeExc (injectSum (Const s)))
 reassociate (Right (Right (Right (Right a)))) = Right a
 
-term :: TermEvaluator Value -> Subterm Term (TermEvaluator Value)
-term eval = Subterm (Term eval) eval
-
 type TermEffects = Goto GotoEffects Value ': GotoEffects
 type GotoEffects
   = '[ LoopControl Value