Pass value in Interface

src/Data/Abstract/Value.hs

@@ -39,7 +39,7 @@ instance (Ord location) => Ord1 (Closure location) where liftCompare = genericLi
 instance (Show location) => Show1 (Closure location) where liftShowsPrec = genericLiftShowsPrec
 
 -- | A function value consisting of a list of parameters, the body of the function, and an environment of bindings captured by the body.
-data Interface location term = Interface (Environment location (Value location term))
+data Interface location term = Interface (Value location term) (Environment location (Value location term))
   deriving (Eq, Generic1, Ord, Show)
 
 instance (Eq location) => Eq1 (Interface location) where liftEq = genericLiftEq
@@ -110,7 +110,7 @@ class AbstractValue v where
 instance (FreeVariables term, Ord location) => ValueRoots location (Value location term) where
   valueRoots v
     | Just (Closure names body env) <- prj v = envRoots env (foldr Set.delete (freeVariables body) names)
-    | Just (Interface env) <- prj v        = envAll env
+    | Just (Interface _ env) <- prj v        = envAll env
     | otherwise                              = mempty
 
 -- | Construct a 'Value' wrapping the value arguments (if any).

src/Data/Syntax.hs

@@ -12,7 +12,7 @@ import Data.Abstract.Address
 import Data.Abstract.Environment
 import Data.Abstract.Eval
 import Data.Abstract.FreeVariables
-import Data.Abstract.Value (LocationFor, AbstractValue(..), Value(..))
+import Data.Abstract.Value (LocationFor, AbstractValue(..), Value)
 import qualified Data.Abstract.Value as Value
 import qualified Data.Abstract.Type as Type
 import Data.Align.Generic
@@ -38,8 +38,6 @@ import GHC.Generics
 import GHC.Stack
 import Prelude hiding (fail)
 
-import Debug.Trace
-
 -- Combinators
 
 -- | Lift syntax and an annotation into a term, injecting the syntax into a union & ensuring the annotation encompasses all children.
@@ -165,11 +163,16 @@ instance ( Monad m
         => Eval t (Value l t) m Program where
   eval ev yield (Program xs) = eval' ev yield xs
     where
-      eval' ev _ [] = do
+      eval' _  yield []  = do
         env <- askEnv @(Value l t)
-        let v = trace ("env: " <> show env) $ inj (Value.Interface env) :: Value l t
+        let v = inj (Value.Interface (unit :: Value l t) env) :: Value l t
         yield v
-      eval' ev _ (a:as) = do
+      eval' ev yield [a] = do
+        env <- askEnv @(Value l t)
+        v1 <- ev pure a
+        let v = inj (Value.Interface (v1 :: Value l t) env) :: Value l t
+        yield v
+      eval' ev yield (a:as) = do
         env <- askEnv @(Value l t)
         extraRoots (envAll env) (ev (const (eval' ev pure as)) a) >>= yield
 
@@ -177,7 +180,6 @@ instance ( Monad m
          , Ord Type.Type
          , MonadGC Type.Type m
          , MonadEnv Type.Type m
-         , AbstractValue Type.Type
          , FreeVariables t
          ) => Eval t Type.Type m Program where
   eval ev yield (Program xs) = eval ev yield xs

src/Data/Syntax/Declaration.hs

@@ -14,6 +14,7 @@ import Data.Abstract.FreeVariables
 import Data.Abstract.Type hiding (Type)
 import qualified Data.Abstract.Value as Value
 import qualified Data.Abstract.Type as Type
+import qualified Data.ByteString.Char8 as BC
 import Data.Abstract.Value
 import Data.Align.Generic
 import Data.Foldable (toList)
@@ -26,9 +27,6 @@ import Diffing.Algorithm
 import GHC.Generics
 import Prelude hiding (fail)
 
-import qualified Data.ByteString.Char8 as BC
-import Debug.Trace
-
 data Function a = Function { functionContext :: ![a], functionName :: !a, functionParameters :: ![a], functionBody :: !a }
   deriving (Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
 
@@ -264,7 +262,6 @@ instance Eq1 Import where liftEq = genericLiftEq
 instance Ord1 Import where liftCompare = genericLiftCompare
 instance Show1 Import where liftShowsPrec = genericLiftShowsPrec
 
--- TODO: Implement Eval instance for Import
 instance ( Monad m
          , Show l
          , Show t
@@ -277,11 +274,13 @@ instance ( Monad m
   eval _ yield (Import from _ _) = do
     let [name] = toList (freeVariables from)
 
-    require <- require (BC.unpack name)
-    Value.Interface env <- maybe (fail ("expected a program, but got: " <> show require)) pure (prj require :: Maybe (Value.Interface l t))
+    interface <- require (BC.unpack name)
+    Interface _ env <- maybe
+                           (fail ("expected an interface, but got: " <> show interface))
+                           pure
+                           (prj interface :: Maybe (Value.Interface l t))
 
-    trace ("[Import] " <> show name <> ": " <> show require) $
-      localEnv (envUnion env) (yield require)
+    localEnv (envUnion env) (yield interface)
 
 instance MonadFail m => Eval t Type.Type m Import