Merge pull request #1563 from github/array-literals

Evaluatable instance for Array literals.

src/Control/Abstract/Value.hs

@@ -67,6 +67,9 @@ class (MonadAnalysis term value m, Show value) => MonadValue term value m where
   -- | Construct an N-ary tuple of multiple (possibly-disjoint) values
   multiple :: [value] -> m value
 
+  -- | Construct an array of zero or more values.
+  array :: [value] -> m value
+
   -- | Eliminate boolean values. TODO: s/boolean/truthy
   ifthenelse :: value -> m a -> m a -> m a
 
@@ -132,6 +135,8 @@ instance ( FreeVariables term
 
   multiple = pure . injValue . Value.Tuple
 
+  array    = pure . injValue . Value.Array
+
   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)
@@ -217,6 +222,7 @@ instance (Alternative m, MonadAnalysis term Type m, MonadFresh m) => MonadValue
   symbol _   = pure Type.Symbol
   rational _ = pure Type.Rational
   multiple   = pure . Type.Product
+  array      = pure . Type.Array
 
   ifthenelse cond if' else' = unify cond Bool *> (if' <|> else')
 

src/Data/Abstract/Type.hs

@@ -19,6 +19,7 @@ data Type
   | Type :-> Type  -- ^ Binary function types.
   | Var TName      -- ^ A type variable.
   | Product [Type] -- ^ N-ary products.
+  | Array [Type]   -- ^ Arrays. Note that this is heterogenous.
   deriving (Eq, Ord, Show)
 
 -- TODO: À la carte representation of types.

src/Data/Abstract/Value.hs

@@ -14,15 +14,16 @@ import Prelude hiding (Float, Integer, String, Rational, fail)
 import qualified Prelude
 
 type ValueConstructors location term
-  = '[Closure location term
-    , Unit
+  = '[Array
     , Boolean
+    , Closure location term
     , Float
     , Integer
     , String
     , Rational
     , Symbol
     , Tuple
+    , Unit
     ]
 
 -- | Open union of primitive values that terms can be evaluated to.
@@ -111,10 +112,9 @@ instance Eq1 Float where liftEq = genericLiftEq
 instance Ord1 Float where liftCompare = genericLiftCompare
 instance Show1 Float where liftShowsPrec = genericLiftShowsPrec
 
--- Zero or more values.
--- TODO: Investigate whether we should use Vector for this.
--- TODO: Should we have a Some type over a nonemmpty list? Or does this merit one?
-
+-- | Zero or more values. Fixed-size at interpretation time.
+--   TODO: Investigate whether we should use Vector for this.
+--   TODO: Should we have a Some type over a nonemmpty list? Or does this merit one?
 newtype Tuple value = Tuple [value]
   deriving (Eq, Generic1, Ord, Show)
 
@@ -122,6 +122,15 @@ instance Eq1 Tuple where liftEq = genericLiftEq
 instance Ord1 Tuple where liftCompare = genericLiftCompare
 instance Show1 Tuple where liftShowsPrec = genericLiftShowsPrec
 
+-- | Zero or more values. Dynamically resized as needed at interpretation time.
+--   TODO: Vector? Seq?
+newtype Array value = Array [value]
+  deriving (Eq, Generic1, Ord, Show)
+
+instance Eq1 Array where liftEq = genericLiftEq
+instance Ord1 Array where liftCompare = genericLiftCompare
+instance Show1 Array where liftShowsPrec = genericLiftShowsPrec
+
 -- | The environment for an abstract value type.
 type EnvironmentFor v = Environment (LocationFor v) v
 

src/Data/Syntax/Literal.hs

@@ -205,9 +205,8 @@ instance Eq1 Array where liftEq = genericLiftEq
 instance Ord1 Array where liftCompare = genericLiftCompare
 instance Show1 Array where liftShowsPrec = genericLiftShowsPrec
 
--- TODO: Implement Eval instance for Array
-instance Evaluatable Array
-
+instance Evaluatable Array where
+  eval (Array a) = array =<< traverse subtermValue a
 
 newtype Hash a = Hash { hashElements :: [a] }
   deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)