Merge branch 'master' into assignment-api

src/Control/Abstract/Value.hs

@@ -73,9 +73,6 @@ class Show value => AbstractIntro value where
   -- | Construct a rational value.
   rational :: Rational -> value
 
-  -- | Construct an N-ary tuple of multiple (possibly-disjoint) values
-  multiple :: [value] -> value
-
   -- | Construct a key-value pair for use in a hash.
   kvPair :: value -> value -> value
 
@@ -114,8 +111,11 @@ class (AbstractFunction address value effects, AbstractIntro value) => AbstractV
   liftBitwise2 :: (forall a . (Integral a, Bits a) => a -> a -> a)
                -> (value -> value -> Evaluator address value effects value)
 
+  -- | Construct an N-ary tuple of multiple (possibly-disjoint) values
+  tuple :: [address] -> Evaluator address value effects value
+
   -- | Construct an array of zero or more values.
-  array :: [value] -> Evaluator address value effects value
+  array :: [address] -> Evaluator address value effects value
 
   -- | Extract the contents of a key-value pair as a tuple.
   asPair :: value -> Evaluator address value effects (value, value)
@@ -127,7 +127,7 @@ class (AbstractFunction address value effects, AbstractIntro value) => AbstractV
   ifthenelse :: value -> Evaluator address value effects a -> Evaluator address value effects a -> Evaluator address value effects a
 
   -- | @index x i@ computes @x[i]@, with zero-indexing.
-  index :: value -> value -> Evaluator address value effects value
+  index :: value -> value -> Evaluator address value effects address
 
   -- | Build a class value from a name and environment.
   klass :: Name                 -- ^ The new class's identifier

src/Data/Abstract/Type.hs

@@ -108,7 +108,6 @@ instance AbstractIntro Type where
   float _    = Float
   symbol _   = Symbol
   rational _ = Rational
-  multiple   = zeroOrMoreProduct
   hash       = Hash
   kvPair k v = k :* v
 
@@ -151,7 +150,10 @@ instance ( Member (Allocator address Type) effects
       => AbstractValue address Type effects where
   array fields = do
     var <- fresh
-    Array <$> foldr (\ t1 -> (unify t1 =<<)) (pure (Var var)) fields
+    fieldTypes <- traverse deref fields
+    Array <$> foldr (\ t1 -> (unify t1 =<<)) (pure (Var var)) fieldTypes
+
+  tuple fields = zeroOrMoreProduct <$> traverse deref fields
 
   klass _ _ _   = pure Object
   namespace _ _ = pure Unit
@@ -167,7 +169,8 @@ instance ( Member (Allocator address Type) effects
   index arr sub = do
     _ <- unify sub Int
     field <- fresh
-    Var field <$ unify (Array (Var field)) arr
+    _ <- unify (Array (Var field)) arr
+    box (Var field)
 
   ifthenelse cond if' else' = unify cond Bool *> (if' <|> else')
 

src/Data/Abstract/Value.hs

@@ -22,8 +22,8 @@ data Value address body
   | Float    (Number.Number Scientific)
   | String Text
   | Symbol Text
-  | Tuple [Value address body]
-  | Array [Value address body]
+  | Tuple [address]
+  | Array [address]
   | Class Name (Environment address)
   | Namespace Name (Environment address)
   | KVPair (Value address body) (Value address body)
@@ -92,8 +92,6 @@ instance Show address => AbstractIntro (Value address body) where
   symbol   = Symbol
   rational = Rational . Number.Ratio
 
-  multiple = Tuple
-
   kvPair = KVPair
   hash = Hash . map (uncurry KVPair)
 
@@ -117,7 +115,8 @@ instance ( Coercible body (Eff effects)
     | KVPair k v <- val = pure (k, v)
     | otherwise = throwValueError $ KeyValueError val
 
-  array    = pure . Array
+  tuple = pure . Tuple
+  array = pure . Array
 
   klass n [] env = pure $ Class n env
   klass n supers env = do
@@ -147,12 +146,12 @@ instance ( Coercible body (Eff effects)
 
   index = go where
     tryIdx list ii
-      | ii > genericLength list = throwValueError (BoundsError list ii)
+      | ii > genericLength list = box =<< throwValueError (BoundsError list ii)
       | otherwise               = pure (genericIndex list ii)
     go arr idx
       | (Array arr, Integer (Number.Integer i)) <- (arr, idx) = tryIdx arr i
       | (Tuple tup, Integer (Number.Integer i)) <- (arr, idx) = tryIdx tup i
-      | otherwise = throwValueError (IndexError arr idx)
+      | otherwise = box =<< throwValueError (IndexError arr idx)
 
   liftNumeric f arg
     | Integer (Number.Integer i) <- arg = pure . integer  $ f i
@@ -237,7 +236,7 @@ data ValueError address body resume where
   -- Indicates that we encountered an arithmetic exception inside Haskell-native number crunching.
   ArithmeticError        :: ArithException                           -> ValueError address body (Value address body)
   -- Out-of-bounds error
-  BoundsError            :: [Value address body] -> Prelude.Integer  -> ValueError address body (Value address body)
+  BoundsError            :: [address]          -> Prelude.Integer    -> ValueError address body (Value address body)
 
 
 instance Eq address => Eq1 (ValueError address body) where

src/Data/Syntax/Declaration.hs

@@ -101,7 +101,7 @@ instance Show1 VariableDeclaration where liftShowsPrec = genericLiftShowsPrec
 
 instance Evaluatable VariableDeclaration where
   eval (VariableDeclaration [])   = rvalBox unit
-  eval (VariableDeclaration decs) = rvalBox =<< (multiple <$> traverse subtermValue decs)
+  eval (VariableDeclaration decs) = rvalBox =<< tuple =<< traverse subtermAddress decs
 
 instance Declarations a => Declarations (VariableDeclaration a) where
   declaredName (VariableDeclaration vars) = case vars of

src/Data/Syntax/Expression.hs

@@ -215,7 +215,7 @@ instance Show1 Subscript where liftShowsPrec = genericLiftShowsPrec
 -- TODO: Finish Eval instance for Subscript
 -- TODO return a special LvalSubscript instance here
 instance Evaluatable Subscript where
-  eval (Subscript l [r]) = rvalBox =<< join (index <$> subtermValue l <*> subtermValue r)
+  eval (Subscript l [r]) = Rval <$> join (index <$> subtermValue l <*> subtermValue r)
   eval (Subscript _ _)   = rvalBox =<< throwResumable (Unspecialized "Eval unspecialized for subscript with slices")
   eval (Member _ _)      = rvalBox =<< throwResumable (Unspecialized "Eval unspecialized for member access")
 

src/Data/Syntax/Literal.hs

@@ -169,7 +169,7 @@ instance Ord1 Array where liftCompare = genericLiftCompare
 instance Show1 Array where liftShowsPrec = genericLiftShowsPrec
 
 instance Evaluatable Array where
-  eval (Array a) = rvalBox =<< (array =<< traverse subtermValue a)
+  eval (Array a) = rvalBox =<< array =<< traverse subtermAddress a
 
 newtype Hash a = Hash { hashElements :: [a] }
   deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Hashable1, Diffable, Mergeable, FreeVariables1, Declarations1, ToJSONFields1, Named1, Message1)
@@ -200,7 +200,7 @@ instance Ord1 Tuple where liftCompare = genericLiftCompare
 instance Show1 Tuple where liftShowsPrec = genericLiftShowsPrec
 
 instance Evaluatable Tuple where
-  eval (Tuple cs) = rvalBox =<< (multiple <$> traverse subtermValue cs)
+  eval (Tuple cs) = rvalBox =<< tuple =<< traverse subtermAddress cs
 
 newtype Set a = Set { setElements :: [a] }
   deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)