implement storing class values

src/Control/Abstract/Value.hs

@@ -83,6 +83,8 @@ class (Monad m, Show value) => MonadValue value m where
   -- | Eliminate boolean values. TODO: s/boolean/truthy
   ifthenelse :: value -> m a -> m a -> m a
 
+  klass :: Name -> EnvironmentFor value -> m value
+
   -- | Evaluate an abstraction (a binder like a lambda or method definition).
   abstract :: (FreeVariables term, MonadControl term m) => [Name] -> Subterm term (m value) -> m value
   -- | Evaluate an application (like a function call).
@@ -147,6 +149,8 @@ instance ( Monad m
 
   array    = pure . injValue . Value.Array
 
+  klass n  = pure . injValue . Class n
+
   ifthenelse cond if' else'
     | Just (Boolean b) <- prjValue cond = if b then if' else else'
     | otherwise = fail ("not defined for non-boolean conditions: " <> show cond)

src/Data/Abstract/Environment.hs

@@ -34,6 +34,9 @@ envPop :: Environment l a -> Environment l a
 envPop (Environment (_ :| [])) = mempty
 envPop (Environment (_ :| a : as)) = Environment (a :| as)
 
+envHead :: Environment l a -> Environment l a
+envHead (Environment (a :| _)) = Environment (a :| [])
+
 -- TODO: Test the flattening behavior
 envPairs :: Environment l a -> [(Name, Address l a)]
 envPairs = Map.toList . fold . unEnvironment

src/Data/Abstract/Value.hs

@@ -16,6 +16,7 @@ import qualified Prelude
 type ValueConstructors
   = '[Array
     , Boolean
+    , Class
     , Closure
     , Float
     , Integer
@@ -131,6 +132,15 @@ instance Eq1 Array where liftEq = genericLiftEq
 instance Ord1 Array where liftCompare = genericLiftCompare
 instance Show1 Array where liftShowsPrec = genericLiftShowsPrec
 
+data Class value = Class
+  { _className  :: Name
+  , _classScope :: Environment Precise value
+  } deriving (Eq, Generic1, Ord, Show)
+
+instance Eq1 Class where liftEq = genericLiftEq
+instance Ord1 Class where liftCompare = genericLiftCompare
+instance Show1 Class where liftShowsPrec = genericLiftShowsPrec
+
 -- | The environment for an abstract value type.
 type EnvironmentFor v = Environment (LocationFor v) v
 

src/Data/Syntax/Declaration.hs

@@ -147,8 +147,9 @@ instance Evaluatable Class where
   eval Class{..} = do
     let name = freeVariable (subterm classIdentifier)
     (v, addr) <- letrec name $ do
-
-      subtermValue classBody
+      void $ subtermValue classBody
+      classEnv <- envHead <$> askLocalEnv
+      klass name classEnv
 
     v <$ modifyGlobalEnv (envInsert name addr)