Merge pull request #2097 from github/value-effects

Encode functions as effects

src/Analysis/Abstract/Graph.hs

@@ -17,7 +17,7 @@ module Analysis.Abstract.Graph
 ) where
 
 import           Algebra.Graph.Export.Dot hiding (vertexName)
-import           Control.Abstract
+import           Control.Abstract hiding (Function(..))
 import           Data.Abstract.Address
 import           Data.Abstract.Ref
 import           Data.Abstract.Declarations

src/Control/Abstract/Primitive.hs

@@ -60,9 +60,9 @@ defineNamespace name scope = define name $ do
   binds <- Env.head <$> locally (scope >> getEnv)
   namespace name Nothing binds
 
-lambda :: ( AbstractFunction address value effects
-          , HasCallStack
+lambda :: ( HasCallStack
           , Member Fresh effects
+          , Member (Function address value) effects
           , Member (Reader ModuleInfo) effects
           , Member (Reader Span) effects
           )
@@ -70,7 +70,7 @@ lambda :: ( AbstractFunction address value effects
        -> Evaluator address value effects value
 lambda body = withCurrentCallStack callStack $ do
   var <- gensym
-  closure [var] lowerBound (body var)
+  function [var] lowerBound (body var)
 
 builtInPrint :: ( AbstractValue address value effects
                 , HasCallStack
@@ -78,6 +78,7 @@ builtInPrint :: ( AbstractValue address value effects
                 , Member (Deref address value) effects
                 , Member (Env address) effects
                 , Member Fresh effects
+                , Member (Function address value) effects
                 , Member (Reader ModuleInfo) effects
                 , Member (Reader Span) effects
                 , Member (Resumable (EnvironmentError address)) effects
@@ -92,6 +93,7 @@ builtInExport :: ( AbstractValue address value effects
                  , Member (Deref address value) effects
                  , Member (Env address) effects
                  , Member Fresh effects
+                 , Member (Function address value) effects
                  , Member (Reader ModuleInfo) effects
                  , Member (Reader Span) effects
                  , Member (Resumable (EnvironmentError address)) effects

src/Control/Abstract/Value.hs

@@ -2,8 +2,10 @@
 module Control.Abstract.Value
 ( AbstractValue(..)
 , AbstractIntro(..)
-, AbstractFunction(..)
 , Comparator(..)
+, function
+, call
+, Function(..)
 , asBool
 , while
 , doWhile
@@ -37,14 +39,19 @@ data Comparator
   = Concrete (forall a . Ord a => a -> a -> Bool)
   | Generalized
 
-class Show value => AbstractFunction address value effects where
-  -- | Build a closure (a binder like a lambda or method definition).
-  closure :: [Name]                                 -- ^ The parameter names.
-          -> Set Name                               -- ^ The set of free variables to close over.
-          -> Evaluator address value effects address -- ^ The evaluator for the body of the closure.
-          -> Evaluator address value effects value
-  -- | Evaluate an application (like a function call).
-  call :: value -> [Evaluator address value effects address] -> Evaluator address value effects address
+function :: Member (Function address value) effects => [Name] -> Set Name -> Evaluator address value effects address -> Evaluator address value effects value
+function names fvs (Evaluator body) = send (Function names fvs body)
+
+call :: Member (Function address value) effects => value -> [address] -> Evaluator address value effects address
+call fn args = send (Call fn args)
+
+data Function address value m result where
+  Function :: [Name] -> Set Name -> m address -> Function address value m value
+  Call     :: value -> [address]              -> Function address value m address
+
+instance PureEffect (Function address value) where
+  handle handler (Request (Function name fvs body) k) = Request (Function name fvs (handler body)) (handler . k)
+  handle handler (Request (Call fn addrs)          k) = Request (Call fn addrs)                    (handler . k)
 
 
 class Show value => AbstractIntro value where
@@ -84,7 +91,7 @@ class Show value => AbstractIntro value where
 -- | A 'Monad' abstracting the evaluation of (and under) binding constructs (functions, methods, etc).
 --
 --   This allows us to abstract the choice of whether to evaluate under binders for different value types.
-class (AbstractFunction address value effects, AbstractIntro value) => AbstractValue address value effects where
+class AbstractIntro value => AbstractValue address value effects where
   -- | Lift a unary operator over a 'Num' to a function on 'value's.
   liftNumeric  :: (forall a . Num a => a -> a)
                -> (value -> Evaluator address value effects value)

src/Data/Abstract/Evaluatable.hs

@@ -25,7 +25,7 @@ import Control.Abstract.Environment as X hiding (runEnvironmentError, runEnviron
 import Control.Abstract.Evaluator as X hiding (LoopControl(..), Return(..), catchLoopControl, runLoopControl, catchReturn, runReturn)
 import Control.Abstract.Heap as X hiding (AddressError(..), runAddressError, runAddressErrorWith)
 import Control.Abstract.Modules as X (Modules, ResolutionError(..), load, lookupModule, listModulesInDir, require, resolve)
-import Control.Abstract.Value as X
+import Control.Abstract.Value as X hiding (Function(..))
 import Data.Abstract.Declarations as X
 import Data.Abstract.Environment as X
 import Data.Abstract.FreeVariables as X
@@ -53,6 +53,7 @@ class (Show1 constr, Foldable constr) => Evaluatable constr where
           , Member (Env address) effects
           , Member (Exc (LoopControl address)) effects
           , Member (Exc (Return address)) effects
+          , Member (Function address value) effects
           , Member (Modules address) effects
           , Member (Reader ModuleInfo) effects
           , Member (Reader PackageInfo) effects
@@ -71,7 +72,7 @@ class (Show1 constr, Foldable constr) => Evaluatable constr where
     rvalBox v
 
 
-evaluate :: ( AbstractValue address value inner
+evaluate :: ( AbstractValue address value valueEffects
             , Allocatable address (Reader ModuleInfo ': effects)
             , Derefable address (Allocator address value ': Reader ModuleInfo ': effects)
             , Declarations term
@@ -96,15 +97,17 @@ evaluate :: ( AbstractValue address value inner
             , Recursive term
             , Reducer value (Cell address value)
             , ValueRoots address value
-            , inner ~ (Exc (LoopControl address) ': Exc (Return address) ': Env address ': Deref address value ': Allocator address value ': Reader ModuleInfo ': effects)
+            , moduleEffects ~ (Exc (LoopControl address) ': Exc (Return address) ': Env address ': Deref address value ': Allocator address value ': Reader ModuleInfo ': effects)
+            , valueEffects ~ (Function address value ': moduleEffects)
             )
          => proxy lang
-         -> (SubtermAlgebra Module      term (TermEvaluator term address value inner address)            -> SubtermAlgebra Module      term (TermEvaluator term address value inner address))
-         -> (SubtermAlgebra (Base term) term (TermEvaluator term address value inner (ValueRef address)) -> SubtermAlgebra (Base term) term (TermEvaluator term address value inner (ValueRef address)))
+         -> (SubtermAlgebra Module      term (TermEvaluator term address value moduleEffects address)            -> SubtermAlgebra Module      term (TermEvaluator term address value moduleEffects address))
+         -> (SubtermAlgebra (Base term) term (TermEvaluator term address value valueEffects (ValueRef address)) -> SubtermAlgebra (Base term) term (TermEvaluator term address value valueEffects (ValueRef address)))
+         -> (forall x . Evaluator address value valueEffects x -> Evaluator address value moduleEffects x)
          -> [Module term]
          -> TermEvaluator term address value effects (ModuleTable (NonEmpty (Module (ModuleResult address))))
-evaluate lang analyzeModule analyzeTerm modules = do
-  (preludeBinds, _) <- TermEvaluator . runInModule lowerBound moduleInfoFromCallStack $ do
+evaluate lang analyzeModule analyzeTerm runValue modules = do
+  (preludeBinds, _) <- TermEvaluator . runInModule lowerBound moduleInfoFromCallStack . runValue $ do
     definePrelude lang
     box unit
   foldr (run preludeBinds) ask modules
@@ -116,9 +119,9 @@ evaluate lang analyzeModule analyzeTerm modules = do
           -- FIXME: this should be some sort of Monoidal insert à la the Heap to accommodate multiple Go files being part of the same module.
           local (ModuleTable.insert (modulePath (moduleInfo m)) ((evaluated <$ m) :| [])) rest
 
-        evalModuleBody term = Subterm term (do
+        evalModuleBody term = Subterm term (coerce runValue (do
           result <- foldSubterms (analyzeTerm (TermEvaluator . eval . fmap (second runTermEvaluator))) term >>= TermEvaluator . address
-          result <$ TermEvaluator (postlude lang))
+          result <$ TermEvaluator (postlude lang)))
 
         runInModule preludeBinds info
           = runReader info
@@ -142,6 +145,7 @@ class HasPrelude (language :: Language) where
                    , Member (Deref address value) effects
                    , Member (Env address) effects
                    , Member Fresh effects
+                   , Member (Function address value) effects
                    , Member (Reader ModuleInfo) effects
                    , Member (Reader Span) effects
                    , Member (Resumable (EnvironmentError address)) effects

src/Data/Abstract/Value/Abstract.hs

@@ -1,7 +1,10 @@
-{-# LANGUAGE GADTs, UndecidableInstances #-}
-module Data.Abstract.Value.Abstract ( Abstract (..) ) where
+{-# LANGUAGE GADTs, LambdaCase, TypeOperators, UndecidableInstances #-}
+module Data.Abstract.Value.Abstract
+( Abstract (..)
+, runFunction
+) where
 
-import Control.Abstract
+import Control.Abstract as Abstract
 import Data.Abstract.Environment as Env
 import Prologue
 
@@ -9,6 +12,28 @@ data Abstract = Abstract
   deriving (Eq, Ord, Show)
 
 
+runFunction :: ( Member (Allocator address Abstract) effects
+               , Member (Deref address Abstract) effects
+               , Member (Env address) effects
+               , Member (Exc (Return address)) effects
+               , Member Fresh effects
+               , PureEffects effects
+               )
+            => Evaluator address Abstract (Function address Abstract ': effects) a
+            -> Evaluator address Abstract effects a
+runFunction = interpret $ \case
+  Function params _ body -> do
+    env <- foldr (\ name rest -> do
+      addr <- alloc name
+      assign addr Abstract
+      Env.insert name addr <$> rest) (pure lowerBound) params
+    addr <- locally (bindAll env *> catchReturn (runFunction (Evaluator body)))
+    deref addr
+  Call _ params -> do
+    traverse_ deref params
+    box Abstract
+
+
 instance Ord address => ValueRoots address Abstract where
   valueRoots = mempty
 
@@ -28,28 +53,6 @@ instance AbstractIntro Abstract where
   null       = Abstract
 
 instance ( Member (Allocator address Abstract) effects
-         , Member (Deref address Abstract) effects
-         , Member (Env address) effects
-         , Member (Exc (Return address)) effects
-         , Member Fresh effects
-         )
-      => AbstractFunction address Abstract effects where
-  closure names _ body = do
-    binds <- foldr (\ name rest -> do
-      addr <- alloc name
-      assign addr Abstract
-      Env.insert name addr <$> rest) (pure lowerBound) names
-    addr <- locally (bindAll binds *> catchReturn body)
-    deref addr
-
-  call Abstract params = do
-    traverse_ (>>= deref) params
-    box Abstract
-
-instance ( Member (Allocator address Abstract) effects
-         , Member (Deref address Abstract) effects
-         , Member (Env address) effects
-         , Member (Exc (Return address)) effects
          , Member NonDet effects
          , Member Fresh effects
          )

src/Data/Abstract/Value/Concrete.hs

@@ -3,13 +3,15 @@ module Data.Abstract.Value.Concrete
   ( Value (..)
   , ValueError (..)
   , ClosureBody (..)
+  , runFunction
   , materializeEnvironment
   , runValueError
   , runValueErrorWith
   , throwValueError
   ) where
 
-import Control.Abstract
+import qualified Control.Abstract as Abstract
+import Control.Abstract hiding (Function(..))
 import Data.Abstract.Environment (Environment, Bindings)
 import qualified Data.Abstract.Environment as Env
 import Data.Abstract.Name
@@ -58,40 +60,40 @@ instance Ord address => ValueRoots address (Value address body) where
     | otherwise                = mempty
 
 
-instance AbstractHole (Value address body) where
-  hole = Hole
-
-instance ( Coercible body (Eff effects)
-         , Member (Allocator address (Value address body)) effects
-         , Member (Env address) effects
-         , Member Fresh effects
-         , Member (Reader ModuleInfo) effects
-         , Member (Reader PackageInfo) effects
-         , Member (Resumable (ValueError address body)) effects
-         , Member (Exc (Return address)) effects
-         , Show address
-         )
-      => AbstractFunction address (Value address body) effects where
-  closure parameters freeVariables body = do
+runFunction :: ( Member (Allocator address (Value address body)) effects
+               , Member (Env address) effects
+               , Member (Exc (Return address)) effects
+               , Member Fresh effects
+               , Member (Reader ModuleInfo) effects
+               , Member (Reader PackageInfo) effects
+               , Member (Resumable (ValueError address body)) effects
+               , PureEffects effects
+               )
+            => (body address -> Evaluator address (Value address body) (Abstract.Function address (Value address body) ': effects) address)
+            -> (Evaluator address value (Abstract.Function address (Value address body) ': effects) address -> body address)
+            -> Evaluator address (Value address body) (Abstract.Function address (Value address body) ': effects) a
+            -> Evaluator address (Value address body) effects a
+runFunction toEvaluator fromEvaluator = interpret $ \case
+  Abstract.Function params fvs body -> do
     packageInfo <- currentPackage
     moduleInfo <- currentModule
     i <- fresh
-    Closure packageInfo moduleInfo parameters (ClosureBody i (coerce (lowerEff body))) <$> close (foldr Set.delete freeVariables parameters)
-
-  call op params = do
+    Closure packageInfo moduleInfo params (ClosureBody i (fromEvaluator (Evaluator body))) <$> close (foldr Set.delete fvs params)
+  Abstract.Call op params -> do
     case op of
       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
-          bindings <- foldr (\ (name, param) rest -> do
-            addr <- param
-            Env.insert name addr <$> rest) (pure lowerBound) (zip names params)
+          bindings <- foldr (\ (name, addr) rest -> Env.insert name addr <$> rest) (pure lowerBound) (zip names params)
           let fnEnv = Env.push env
-          withEnv fnEnv (catchReturn (bindAll bindings *> raiseEff (coerce body)))
-      _ -> box =<< throwValueError (CallError op)
+          withEnv fnEnv (catchReturn (bindAll bindings *> runFunction toEvaluator fromEvaluator (toEvaluator body)))
+      _ -> throwValueError (CallError op) >>= box
 
 
+instance AbstractHole (Value address body) where
+  hole = Hole
+
 instance Show address => AbstractIntro (Value address body) where
   unit     = Unit
   integer  = Integer . Number.Integer

src/Data/Abstract/Value/Type.hs

@@ -6,9 +6,11 @@ module Data.Abstract.Value.Type
   , runTypes
   , runTypesWith
   , unify
+  , runFunction
   ) where
 
-import Control.Abstract hiding (raiseHandler)
+import qualified Control.Abstract as Abstract
+import Control.Abstract hiding (Function(..), raiseHandler)
 import Control.Monad.Effect.Internal (raiseHandler)
 import Data.Abstract.Environment as Env
 import Data.Semigroup.Foldable (foldMap1)
@@ -215,6 +217,35 @@ instance Ord address => ValueRoots address Type where
   valueRoots _ = mempty
 
 
+runFunction :: ( Member (Allocator address Type) effects
+               , Member (Deref address Type) effects
+               , Member (Env address) effects
+               , Member (Exc (Return address)) effects
+               , Member Fresh effects
+               , Member (Resumable TypeError) effects
+               , Member (State TypeMap) effects
+               , PureEffects effects
+               )
+            => Evaluator address Type (Abstract.Function address Type ': effects) a
+            -> Evaluator address Type effects a
+runFunction = interpret $ \case
+  Abstract.Function params _ body -> do
+    (env, tvars) <- foldr (\ name rest -> do
+      addr <- alloc name
+      tvar <- Var <$> fresh
+      assign addr tvar
+      bimap (Env.insert name addr) (tvar :) <$> rest) (pure (lowerBound, [])) params
+    (zeroOrMoreProduct tvars :->) <$> (locally (catchReturn (bindAll env *> runFunction (Evaluator body))) >>= deref)
+  Abstract.Call op params -> do
+    tvar <- fresh
+    paramTypes <- traverse deref params
+    let needed = zeroOrMoreProduct paramTypes :-> Var tvar
+    unified <- op `unify` needed
+    case unified of
+      _ :-> ret -> box ret
+      actual    -> throwResumable (UnificationError needed actual) >>= box
+
+
 instance AbstractHole Type where
   hole = Hole
 
@@ -231,39 +262,9 @@ instance AbstractIntro Type where
 
   null        = Null
 
-
-instance ( Member (Allocator address Type) effects
-         , Member (Deref address Type) effects
-         , Member (Env address) effects
-         , Member (Exc (Return address)) effects
-         , Member Fresh effects
-         , Member (Resumable TypeError) effects
-         , Member (State TypeMap) effects
-         )
-      => AbstractFunction address Type effects where
-  closure names _ body = do
-    (binds, tvars) <- foldr (\ name rest -> do
-      addr <- alloc name
-      tvar <- Var <$> fresh
-      assign addr tvar
-      bimap (Env.insert name addr) (tvar :) <$> rest) (pure (lowerBound, [])) names
-    (zeroOrMoreProduct tvars :->) <$> (deref =<< locally (catchReturn (bindAll binds *> body)))
-
-  call op params = do
-    tvar <- fresh
-    paramTypes <- traverse (>>= deref) params
-    let needed = zeroOrMoreProduct paramTypes :-> Var tvar
-    unified <- op `unify` needed
-    case unified of
-      _ :-> ret -> box ret
-      gotten    -> box =<< throwResumable (UnificationError needed gotten)
-
-
 -- | Discard the value arguments (if any), constructing a 'Type' instead.
 instance ( Member (Allocator address Type) effects
          , Member (Deref address Type) effects
-         , Member (Env address) effects
-         , Member (Exc (Return address)) effects
          , Member Fresh effects
          , Member NonDet effects
          , Member (Resumable TypeError) effects

src/Data/Syntax/Declaration.hs

@@ -26,7 +26,7 @@ instance Show1 Function where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable Function where
   eval Function{..} = do
     name <- maybeM (throwEvalError NoNameError) (declaredName (subterm functionName))
-    (_, addr) <- letrec name (closure (paramNames functionParameters) (freeVariables functionBody) (subtermAddress functionBody))
+    (_, addr) <- letrec name (function (paramNames functionParameters) (freeVariables functionBody) (subtermAddress functionBody))
     bind name addr
     pure (Rval addr)
     where paramNames = foldMap (maybeToList . declaredName . subterm)
@@ -53,7 +53,7 @@ instance Diffable Method where
 instance Evaluatable Method where
   eval Method{..} = do
     name <- maybeM (throwEvalError NoNameError) (declaredName (subterm methodName))
-    (_, addr) <- letrec name (closure (paramNames methodParameters) (freeVariables methodBody) (subtermAddress methodBody))
+    (_, addr) <- letrec name (function (paramNames methodParameters) (freeVariables methodBody) (subtermAddress methodBody))
     bind name addr
     pure (Rval addr)
     where paramNames = foldMap (maybeToList . declaredName . subterm)

src/Data/Syntax/Expression.hs

@@ -21,7 +21,8 @@ instance Show1 Call where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable Call where
   eval Call{..} = do
     op <- subtermValue callFunction
-    Rval <$> call op (map subtermAddress callParams)
+    args <- traverse subtermAddress callParams
+    Rval <$> call op args
 
 data LessThan a = LessThan { lhs :: a, rhs :: a }
   deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, Named1, Message1)

src/Language/Ruby/Syntax.hs

@@ -56,7 +56,8 @@ instance Evaluatable Send where
           Just sel -> subtermAddress sel
           Nothing  -> variable (name "call")
     func <- deref =<< maybe sel (flip evaluateInScopedEnv sel <=< subtermAddress) sendReceiver
-    Rval <$> call func (map subtermAddress sendArgs) -- TODO pass through sendBlock
+    args <- traverse subtermAddress sendArgs
+    Rval <$> call func args -- TODO pass through sendBlock
 
 data Require a = Require { requireRelative :: Bool, requirePath :: !a }
   deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, Named1, Message1)

src/Semantic/Graph.hs

@@ -34,9 +34,10 @@ import           Data.Abstract.Evaluatable
 import           Data.Abstract.Module
 import qualified Data.Abstract.ModuleTable as ModuleTable
 import           Data.Abstract.Package as Package
-import           Data.Abstract.Value.Abstract
-import           Data.Abstract.Value.Concrete (Value, ValueError (..), runValueErrorWith)
-import           Data.Abstract.Value.Type
+import           Data.Abstract.Value.Abstract as Abstract
+import           Data.Abstract.Value.Concrete as Concrete (Value, ValueError (..), runFunction, runValueErrorWith)
+import           Data.Abstract.Value.Type as Type
+import           Data.Coerce
 import           Data.Graph
 import           Data.Graph.Vertex (VertexDeclarationStrategy, VertexDeclarationWithStrategy)
 import           Data.Project
@@ -112,7 +113,7 @@ runCallGraph lang includePackages modules package = do
         . providingLiveSet
         . runReader (lowerBound @(ModuleTable (NonEmpty (Module (ModuleResult (Hole (Maybe Name) (Located Monovariant)))))))
         . raiseHandler (runModules (ModuleTable.modulePaths (packageModules package)))
-  extractGraph <$> runEvaluator (runGraphAnalysis (evaluate lang analyzeModule analyzeTerm modules))
+  extractGraph <$> runEvaluator (runGraphAnalysis (evaluate lang analyzeModule analyzeTerm Abstract.runFunction modules))
 
 runImportGraphToModuleInfos :: forall effs lang term.
                   ( Declarations term
@@ -176,32 +177,33 @@ runImportGraph lang (package :: Package term) f =
         . runState lowerBound
         . runReader lowerBound
         . runModules (ModuleTable.modulePaths (packageModules package))
-        . runTermEvaluator @_ @_ @(Value (Hole (Maybe Name) Precise) (ImportGraphEff term (Hole (Maybe Name) Precise) effs))
+        . runTermEvaluator @_ @_ @(Value (Hole (Maybe Name) Precise) (ImportGraphEff (Hole (Maybe Name) Precise) effs))
         . runReader (packageInfo package)
         . runReader lowerBound
-  in extractGraph <$> runEvaluator (runImportGraphAnalysis (evaluate @_ @_ @_ @_ @term lang analyzeModule id (ModuleTable.toPairs (packageModules package) >>= toList . snd)))
+  in extractGraph <$> runEvaluator (runImportGraphAnalysis (evaluate lang analyzeModule id (Concrete.runFunction coerce coerce) (ModuleTable.toPairs (packageModules package) >>= toList . snd)))
 
-newtype ImportGraphEff term address outerEffects a = ImportGraphEff
-  { runImportGraphEff :: Eff (  Exc (LoopControl address)
+newtype ImportGraphEff address outerEffects a = ImportGraphEff
+  { runImportGraphEff :: Eff (  Function address (Value address (ImportGraphEff address outerEffects))
+                             ': Exc (LoopControl address)
                              ': Exc (Return address)
                              ': Env address
-                             ': Deref address (Value address (ImportGraphEff term address outerEffects))
-                             ': Allocator address (Value address (ImportGraphEff term address outerEffects))
+                             ': Deref address (Value address (ImportGraphEff address outerEffects))
+                             ': Allocator address (Value address (ImportGraphEff address outerEffects))
                              ': Reader ModuleInfo
                              ': Reader Span
                              ': Reader PackageInfo
                              ': Modules address
                              ': Reader (ModuleTable (NonEmpty (Module (ModuleResult address))))
                              ': State (Graph ModuleInfo)
-                             ': Resumable (ValueError address (ImportGraphEff term address outerEffects))
-                             ': Resumable (AddressError address (Value address (ImportGraphEff term address outerEffects)))
+                             ': Resumable (ValueError address (ImportGraphEff address outerEffects))
+                             ': Resumable (AddressError address (Value address (ImportGraphEff address outerEffects)))
                              ': Resumable ResolutionError
                              ': Resumable EvalError
                              ': Resumable (EnvironmentError address)
-                             ': Resumable (Unspecialized (Value address (ImportGraphEff term address outerEffects)))
+                             ': Resumable (Unspecialized (Value address (ImportGraphEff address outerEffects)))
                              ': Resumable (LoadError address)
                              ': Fresh
-                             ': State (Heap address Latest (Value address (ImportGraphEff term address outerEffects)))
+                             ': State (Heap address Latest (Value address (ImportGraphEff address outerEffects)))
                              ': outerEffects
                              ) a
   }

src/Semantic/Util.hs

@@ -14,9 +14,10 @@ import           Data.Abstract.Evaluatable
 import           Data.Abstract.Module
 import qualified Data.Abstract.ModuleTable as ModuleTable
 import           Data.Abstract.Package
-import           Data.Abstract.Value.Concrete
-import           Data.Abstract.Value.Type
+import           Data.Abstract.Value.Concrete as Concrete
+import           Data.Abstract.Value.Type as Type
 import           Data.Blob
+import           Data.Coerce
 import           Data.Functor.Foldable
 import           Data.Graph (topologicalSort)
 import qualified Data.Language as Language
@@ -53,7 +54,8 @@ justEvaluating
   . runValueError
 
 newtype UtilEff address a = UtilEff
-  { runUtilEff :: Eff '[ Exc (LoopControl address)
+  { runUtilEff :: Eff '[ Function address (Value address (UtilEff address))
+                       , Exc (LoopControl address)
                        , Exc (Return address)
                        , Env address
                        , Deref address (Value address (UtilEff address))
@@ -128,7 +130,7 @@ evaluateProject' (TaskConfig config logger statter) proxy parser lang paths = ei
        (runReader (lowerBound @Span)
        (runReader (lowerBound @(ModuleTable (NonEmpty (Module (ModuleResult Precise)))))
        (raiseHandler (runModules (ModuleTable.modulePaths (packageModules package)))
-       (evaluate proxy id withTermSpans modules))))))
+       (evaluate proxy id withTermSpans (Concrete.runFunction coerce coerce) modules))))))
 
 
 evaluateProjectWithCaching proxy parser lang path = runTaskWithOptions debugOptions $ do
@@ -139,7 +141,7 @@ evaluateProjectWithCaching proxy parser lang path = runTaskWithOptions debugOpti
        (runReader (lowerBound @Span)
        (runReader (lowerBound @(ModuleTable (NonEmpty (Module (ModuleResult Monovariant)))))
        (raiseHandler (runModules (ModuleTable.modulePaths (packageModules package)))
-       (evaluate proxy id withTermSpans modules)))))
+       (evaluate proxy id withTermSpans Type.runFunction modules)))))
 
 
 parseFile :: Parser term -> FilePath -> IO term

test/Control/Abstract/Evaluator/Spec.hs

@@ -11,6 +11,7 @@ import Data.Abstract.Package
 import Data.Abstract.Value.Concrete as Value
 import Data.Algebra
 import Data.Bifunctor (first)
+import Data.Coerce
 import Data.Functor.Const
 import Data.Sum
 import SpecHelpers hiding (reassociate)
@@ -23,8 +24,9 @@ spec = parallel $ do
 
   it "calls functions" $ do
     (_, expected) <- evaluate $ do
-      identity <- closure [name "x"] lowerBound (variable (name "x"))
-      call identity [box (integer 123)]
+      identity <- function [name "x"] lowerBound (variable (name "x"))
+      addr <- box (integer 123)
+      call identity [addr]
     expected `shouldBe` Right (Value.Integer (Number.Integer 123))
 
 evaluate
@@ -43,13 +45,15 @@ evaluate
   . runEnv lowerBound
   . runReturn
   . runLoopControl
+  . Value.runFunction coerce coerce
 
 reassociate :: Either (SomeExc exc1) (Either (SomeExc exc2) (Either (SomeExc exc3) result)) -> Either (SomeExc (Sum '[exc3, exc2, exc1])) result
 reassociate = mergeExcs . mergeExcs . mergeExcs . Right
 
 type Val = Value Precise SpecEff
 newtype SpecEff a = SpecEff
-  { runSpecEff :: Eff '[ Exc (LoopControl Precise)
+  { runSpecEff :: Eff '[ Function Precise Val
+                       , Exc (LoopControl Precise)
                        , Exc (Return Precise)
                        , Env Precise
                        , Allocator Precise Val