Embed the evaluating action into the closure body.

src/Data/Abstract/Value.hs

@@ -6,6 +6,7 @@ import Data.Abstract.Environment (Environment, emptyEnv, mergeEnvs)
 import qualified Data.Abstract.Environment as Env
 import Data.Abstract.Name
 import qualified Data.Abstract.Number as Number
+import Data.Coerce
 import Data.List (genericIndex, genericLength)
 import Data.Scientific (Scientific)
 import Data.Scientific.Exts
@@ -32,8 +33,16 @@ data Value location body
   | Hole
   deriving (Eq, Ord, Show)
 
-data ClosureBody location body = ClosureBody Label
-  deriving (Eq, Ord, Show)
+data ClosureBody location body = ClosureBody (body (Value location body))
+
+instance Eq   (ClosureBody location body) where
+  _ == _ = True
+
+instance Ord  (ClosureBody location body) where
+  _ `compare` _ = EQ
+
+instance Show (ClosureBody location body) where
+  showsPrec d (ClosureBody _) = showsUnaryWith (const showChar) "ClosureBody" d '_'
 
 
 instance Ord location => ValueRoots location (Value location body) where
@@ -45,7 +54,8 @@ instance Ord location => ValueRoots location (Value location body) where
 instance AbstractHole (Value location body) where
   hole = Hole
 
-instance ( Members '[ Allocator location (Value location body)
+instance ( Coercible body (Eff effects)
+         , Members '[ Allocator location (Value location body)
                     , Reader ModuleInfo
                     , Reader PackageInfo
                     , Resumable (ValueError location body)
@@ -57,17 +67,15 @@ instance ( Members '[ Allocator location (Value location body)
          , Reducer (Value location body) (Cell location (Value location body))
          , Show location
          )
-      => AbstractFunction location (Value location body) (Goto effects (Value location body) ': effects) where
+      => AbstractFunction location (Value location body) effects where
   closure parameters freeVariables body = do
     packageInfo <- currentPackage
     moduleInfo <- currentModule
-    l <- label body
-    Closure packageInfo moduleInfo parameters (ClosureBody l) . Env.bind (foldr Set.delete freeVariables parameters) <$> getEnv
+    Closure packageInfo moduleInfo parameters (ClosureBody (coerce (lowerEff body))) . Env.bind (foldr Set.delete freeVariables parameters) <$> getEnv
 
   call op params = do
     case op of
-      Closure packageInfo moduleInfo names (ClosureBody label) env -> do
-        body <- goto label
+      Closure packageInfo moduleInfo names (ClosureBody body) env -> do
         -- Evaluate the bindings and body with the closure’s package/module info in scope in order to
         -- charge them to the closure's origin.
         withCurrentPackage packageInfo . withCurrentModule moduleInfo $ do
@@ -76,7 +84,7 @@ instance ( Members '[ Allocator location (Value location body)
             a <- alloc name
             assign a v
             Env.insert name a <$> rest) (pure env) (zip names params)
-          localEnv (mergeEnvs bindings) (body `catchReturn` \ (Return value) -> pure value)
+          localEnv (mergeEnvs bindings) (raiseEff (coerce body) `catchReturn` \ (Return value) -> pure value)
       _ -> throwValueError (CallError op)
 
 
@@ -99,7 +107,8 @@ instance Show location => AbstractIntro (Value location body) where
 
 
 -- | Construct a 'Value' wrapping the value arguments (if any).
-instance ( Members '[ Allocator location (Value location body)
+instance ( Coercible body (Eff effects)
+         , Members '[ Allocator location (Value location body)
                     , LoopControl (Value location body)
                     , Reader (Environment location)
                     , Reader ModuleInfo
@@ -113,7 +122,7 @@ instance ( Members '[ Allocator location (Value location body)
          , Reducer (Value location body) (Cell location (Value location body))
          , Show location
          )
-      => AbstractValue location (Value location body) (Goto effects (Value location body) ': effects) where
+      => AbstractValue location (Value location body) effects where
   asPair val
     | KVPair k v <- val = pure (k, v)
     | otherwise = throwValueError $ KeyValueError val

src/Semantic/Graph.hs

@@ -66,8 +66,8 @@ runGraph graphType includePackages project
             . resumingEvalError
             . resumingResolutionError
             . resumingAddressError
-            . runTermEvaluator @_ @_ @(Value (Located Precise) _)
             . resumingValueError
+            . runTermEvaluator @_ @_ @(Value (Located Precise) (Eff _))
             . graphing
 
 -- | Parse a list of files into a 'Package'.
@@ -129,7 +129,7 @@ resumingAddressError = runAddressErrorWith (\ err -> trace ("AddressError:" <> s
   UnallocatedAddress _   -> pure lowerBound
   UninitializedAddress _ -> pure hole)
 
-resumingValueError :: (Members '[State (Environment location), Trace] effects, Show location) => TermEvaluator term location (Value location term) (Resumable (ValueError location term) ': effects) a -> TermEvaluator term location (Value location term) effects a
+resumingValueError :: (Members '[State (Environment location), Trace] effects, Show location) => Evaluator location (Value location body) (Resumable (ValueError location body) ': effects) a -> Evaluator location (Value location body) effects a
 resumingValueError = runValueErrorWith (\ err -> trace ("ValueError" <> show err) *> case err of
   CallError val     -> pure val
   StringError val   -> pure (pack (show val))
@@ -139,7 +139,7 @@ resumingValueError = runValueErrorWith (\ err -> trace ("ValueError" <> show err
   NumericError{}    -> pure hole
   Numeric2Error{}   -> pure hole
   ComparisonError{} -> pure hole
-  NamespaceError{}  -> TermEvaluator getEnv
+  NamespaceError{}  -> getEnv
   BitwiseError{}    -> pure hole
   Bitwise2Error{}   -> pure hole
   KeyValueError{}   -> pure (hole, hole)

src/Semantic/Util.hs

@@ -44,7 +44,7 @@ justEvaluating
   . runEnvironmentError
   . runEvalError
   . runAddressError
-  . runTermEvaluator @_ @Precise
+  . runTermEvaluator @_ @Precise @(Value Precise (Eff _))
   . runValueError
 
 checking

test/SpecHelpers.hs

@@ -89,8 +89,8 @@ testEvaluating
   . runEnvironmentError
   . runEvalError
   . runAddressError
-  . runTermEvaluator @_ @_ @(Value Precise _)
   . runValueError
+  . runTermEvaluator @_ @_ @(Value Precise (Eff _))
 
 deNamespace :: Value Precise term -> Maybe (Name, [Name])
 deNamespace (Namespace name scope) = Just (name, Env.names scope)