From 378b65631a750ad030edeb01790300634e92c278 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Wed, 14 Mar 2018 11:46:23 -0400
Subject: [PATCH] Evaluatable instance for Array literals.

Pretty much identical to the one for tuples.
---
 src/Control/Abstract/Value.hs |  6 ++++++
 src/Data/Abstract/Type.hs     |  1 +
 src/Data/Abstract/Value.hs    | 21 +++++++++++++++------
 src/Data/Syntax/Literal.hs    |  5 ++---
 4 files changed, 24 insertions(+), 9 deletions(-)

diff --git a/src/Control/Abstract/Value.hs b/src/Control/Abstract/Value.hs
index 287b46cff..d14b7d774 100644
--- a/src/Control/Abstract/Value.hs
+++ b/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
 
@@ -126,6 +129,8 @@ instance ( MonadAddressable location (Value location term) m
 
   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)
@@ -209,6 +214,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')
 
diff --git a/src/Data/Abstract/Type.hs b/src/Data/Abstract/Type.hs
index 2ab376de3..15fa96dbe 100644
--- a/src/Data/Abstract/Type.hs
+++ b/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.
diff --git a/src/Data/Abstract/Value.hs b/src/Data/Abstract/Value.hs
index ee99a4b79..33ba6b412 100644
--- a/src/Data/Abstract/Value.hs
+++ b/src/Data/Abstract/Value.hs
@@ -15,15 +15,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.
@@ -112,10 +113,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)
 
@@ -123,6 +123,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
 
diff --git a/src/Data/Syntax/Literal.hs b/src/Data/Syntax/Literal.hs
index c449a36c1..7d851c613 100644
--- a/src/Data/Syntax/Literal.hs
+++ b/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)