From 214045dd98cb066cd0ddb6f556f25688ab9b47a5 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Mon, 30 Apr 2018 16:13:19 -0400 Subject: [PATCH 1/5] Add support for array indexing. To test: ```ruby x = [1,2,3] x[2] ``` should yield 3. --- src/Analysis/Abstract/BadValues.hs | 2 ++ src/Control/Abstract/Value.hs | 11 +++++++++++ src/Data/Abstract/Type.hs | 3 +++ src/Data/Abstract/Value.hs | 9 +++++++++ src/Data/Syntax/Expression.hs | 7 +++++-- 5 files changed, 30 insertions(+), 2 deletions(-) diff --git a/src/Analysis/Abstract/BadValues.hs b/src/Analysis/Abstract/BadValues.hs index cf32d8165..cb526de08 100644 --- a/src/Analysis/Abstract/BadValues.hs +++ b/src/Analysis/Abstract/BadValues.hs @@ -28,6 +28,8 @@ instance ( Interpreter effects result rest m CallError val -> yield val StringError val -> yield (pack (show val)) BoolError{} -> yield True + BoundsError{} -> yield hole + IndexError{} -> yield hole NumericError{} -> yield hole Numeric2Error{} -> yield hole ComparisonError{} -> yield hole diff --git a/src/Control/Abstract/Value.hs b/src/Control/Abstract/Value.hs index b787f4451..b58f7756b 100644 --- a/src/Control/Abstract/Value.hs +++ b/src/Control/Abstract/Value.hs @@ -114,6 +114,10 @@ class (Monad (m effects), Show value) => MonadValue location value (effects :: [ -- | Construct the nil/null datatype. null :: m effects value + -- | @index x i@ computes @x[i]@, with zero-indexing. + index :: value -> value -> m effects value + + -- | Determine whether the given datum is a 'Hole'. isHole :: value -> m effects Bool -- | Build a class value from a name and environment. @@ -197,6 +201,7 @@ class ValueRoots location value where data ValueError location value resume where StringError :: value -> ValueError location value ByteString BoolError :: value -> ValueError location value Bool + IndexError :: value -> value -> ValueError location value value NamespaceError :: Prelude.String -> ValueError location value (Environment location value) ScopedEnvironmentError :: Prelude.String -> ValueError location value (Environment location value) CallError :: value -> ValueError location value value @@ -208,6 +213,10 @@ data ValueError location value resume where KeyValueError :: value -> ValueError location value (value, value) -- Indicates that we encountered an arithmetic exception inside Haskell-native number crunching. ArithmeticError :: ArithException -> ValueError location value value + -- Out-of-bounds error + BoundsError :: [value] -> Integer -> ValueError location value value + + instance Eq value => Eq1 (ValueError location value) where liftEq _ (StringError a) (StringError b) = a == b @@ -215,11 +224,13 @@ instance Eq value => Eq1 (ValueError location value) where liftEq _ (ScopedEnvironmentError a) (ScopedEnvironmentError b) = a == b liftEq _ (CallError a) (CallError b) = a == b liftEq _ (BoolError a) (BoolError c) = a == c + liftEq _ (IndexError a b) (IndexError c d) = (a == c) && (b == d) liftEq _ (Numeric2Error a b) (Numeric2Error c d) = (a == c) && (b == d) liftEq _ (ComparisonError a b) (ComparisonError c d) = (a == c) && (b == d) liftEq _ (Bitwise2Error a b) (Bitwise2Error c d) = (a == c) && (b == d) liftEq _ (BitwiseError a) (BitwiseError b) = a == b liftEq _ (KeyValueError a) (KeyValueError b) = a == b + liftEq _ (BoundsError a b) (BoundsError c d) = (a == c) && (b == d) liftEq _ _ _ = False deriving instance (Show value) => Show (ValueError location value resume) diff --git a/src/Data/Abstract/Type.hs b/src/Data/Abstract/Type.hs index ae9b2298e..a333fd9e2 100644 --- a/src/Data/Abstract/Type.hs +++ b/src/Data/Abstract/Type.hs @@ -123,6 +123,9 @@ instance ( Alternative (m effects) isHole ty = pure (ty == Hole) + index (Array (mem:_)) Int = pure mem + index _ _ = pure Hole + ifthenelse cond if' else' = unify cond Bool *> (if' <|> else') liftNumeric _ Float = pure Float diff --git a/src/Data/Abstract/Value.hs b/src/Data/Abstract/Value.hs index c6e601256..8c62e3aaa 100644 --- a/src/Data/Abstract/Value.hs +++ b/src/Data/Abstract/Value.hs @@ -6,6 +6,7 @@ import Data.Abstract.Environment (Environment) import qualified Data.Abstract.Environment as Env import Data.Abstract.Evaluatable import qualified Data.Abstract.Number as Number +import Data.List (genericIndex, genericLength) import Data.Scientific (Scientific) import Data.Scientific.Exts import qualified Data.Set as Set @@ -264,6 +265,14 @@ instance ( Monad (m effects) isHole val = pure (prjValue val == Just Hole) + index = go where + tryIdx list ii + | ii > genericLength list = throwResumable @(ValueError location (Value location)) (BoundsError list ii) + | otherwise = pure (genericIndex list ii) + go arr idx + | (Just (Array arr, Integer (Number.Integer i))) <- prjPair (arr, idx) = tryIdx arr i + | (Just (Tuple tup, Integer (Number.Integer i))) <- prjPair (arr, idx) = tryIdx tup i + | otherwise = throwResumable @(ValueError location (Value location)) (IndexError arr idx) liftNumeric f arg | Just (Integer (Number.Integer i)) <- prjValue arg = integer $ f i diff --git a/src/Data/Syntax/Expression.hs b/src/Data/Syntax/Expression.hs index ad68168c9..f2135bf59 100644 --- a/src/Data/Syntax/Expression.hs +++ b/src/Data/Syntax/Expression.hs @@ -5,7 +5,7 @@ import Data.Abstract.Evaluatable import Data.Abstract.Number (liftIntegralFrac, liftReal, liftedExponent, liftedFloorDiv) import Data.Fixed import Diffing.Algorithm -import Prologue +import Prologue hiding (index) -- | Typical prefix function application, like `f(x)` in many languages, or `f x` in Haskell. data Call a = Call { callContext :: ![a], callFunction :: !a, callParams :: ![a], callBlock :: !a } @@ -208,7 +208,10 @@ instance Ord1 Subscript where liftCompare = genericLiftCompare instance Show1 Subscript where liftShowsPrec = genericLiftShowsPrec -- TODO: Implement Eval instance for Subscript -instance Evaluatable Subscript +instance Evaluatable Subscript where + eval (Subscript l [r]) = join (index <$> subtermValue l <*> subtermValue r) + eval (Subscript _ _) = throwResumable (Unspecialized ("Eval unspecialized for subscript with slices")) + eval (Member _ _) = throwResumable (Unspecialized ("Eval unspecialized for member access")) -- | Enumeration (e.g. a[1:10:1] in Python (start at index 1, stop at index 10, step 1 element from start to stop)) From 25813e00e07a3e80a080ed02814b12b1b2624870 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Mon, 30 Apr 2018 16:19:17 -0400 Subject: [PATCH 2/5] whitespace --- src/Data/Abstract/Value.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Data/Abstract/Value.hs b/src/Data/Abstract/Value.hs index 8c62e3aaa..cb3a16ec8 100644 --- a/src/Data/Abstract/Value.hs +++ b/src/Data/Abstract/Value.hs @@ -270,7 +270,7 @@ instance ( Monad (m effects) | ii > genericLength list = throwResumable @(ValueError location (Value location)) (BoundsError list ii) | otherwise = pure (genericIndex list ii) go arr idx - | (Just (Array arr, Integer (Number.Integer i))) <- prjPair (arr, idx) = tryIdx arr i + | (Just (Array arr, Integer (Number.Integer i))) <- prjPair (arr, idx) = tryIdx arr i | (Just (Tuple tup, Integer (Number.Integer i))) <- prjPair (arr, idx) = tryIdx tup i | otherwise = throwResumable @(ValueError location (Value location)) (IndexError arr idx) From 2067fb7459bc3f276527dc5b32c55adde5ffacc7 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Mon, 30 Apr 2018 16:29:39 -0400 Subject: [PATCH 3/5] lints --- src/Data/Syntax/Expression.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Data/Syntax/Expression.hs b/src/Data/Syntax/Expression.hs index f2135bf59..48560efd5 100644 --- a/src/Data/Syntax/Expression.hs +++ b/src/Data/Syntax/Expression.hs @@ -210,8 +210,8 @@ instance Show1 Subscript where liftShowsPrec = genericLiftShowsPrec -- TODO: Implement Eval instance for Subscript instance Evaluatable Subscript where eval (Subscript l [r]) = join (index <$> subtermValue l <*> subtermValue r) - eval (Subscript _ _) = throwResumable (Unspecialized ("Eval unspecialized for subscript with slices")) - eval (Member _ _) = throwResumable (Unspecialized ("Eval unspecialized for member access")) + eval (Subscript _ _) = throwResumable (Unspecialized "Eval unspecialized for subscript with slices") + eval (Member _ _) = throwResumable (Unspecialized "Eval unspecialized for member access") -- | Enumeration (e.g. a[1:10:1] in Python (start at index 1, stop at index 10, step 1 element from start to stop)) From ed4ef49b7035779d1733635d79c32ec43dea2af4 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Mon, 30 Apr 2018 16:53:22 -0400 Subject: [PATCH 4/5] Address Josh's comments. --- src/Data/Abstract/Type.hs | 4 +++- src/Data/Abstract/Value.hs | 4 ++-- 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/src/Data/Abstract/Type.hs b/src/Data/Abstract/Type.hs index a333fd9e2..f68e673b8 100644 --- a/src/Data/Abstract/Type.hs +++ b/src/Data/Abstract/Type.hs @@ -42,6 +42,7 @@ data TypeError resume where NumOpError :: Type -> Type -> TypeError Type BitOpError :: Type -> Type -> TypeError Type UnificationError :: Type -> Type -> TypeError Type + SubscriptError :: Type -> Type -> TypeError Type deriving instance Show (TypeError resume) @@ -49,6 +50,7 @@ instance Show1 TypeError where liftShowsPrec _ _ _ (NumOpError l r) = showString "NumOpError " . shows [l, r] liftShowsPrec _ _ _ (BitOpError l r) = showString "BitOpError " . shows [l, r] liftShowsPrec _ _ _ (UnificationError l r) = showString "UnificationError " . shows [l, r] + liftShowsPrec _ _ _ (SubscriptError l r) = showString "SubscriptError " . shows [l, r] instance Eq1 TypeError where liftEq _ (BitOpError a b) (BitOpError c d) = a == c && b == d @@ -124,7 +126,7 @@ instance ( Alternative (m effects) isHole ty = pure (ty == Hole) index (Array (mem:_)) Int = pure mem - index _ _ = pure Hole + index a b = throwResumable (SubscriptError a b) ifthenelse cond if' else' = unify cond Bool *> (if' <|> else') diff --git a/src/Data/Abstract/Value.hs b/src/Data/Abstract/Value.hs index cb3a16ec8..1e8aa41cf 100644 --- a/src/Data/Abstract/Value.hs +++ b/src/Data/Abstract/Value.hs @@ -267,12 +267,12 @@ instance ( Monad (m effects) index = go where tryIdx list ii - | ii > genericLength list = throwResumable @(ValueError location (Value location)) (BoundsError list ii) + | ii > genericLength list = throwValueError (BoundsError list ii) | otherwise = pure (genericIndex list ii) go arr idx | (Just (Array arr, Integer (Number.Integer i))) <- prjPair (arr, idx) = tryIdx arr i | (Just (Tuple tup, Integer (Number.Integer i))) <- prjPair (arr, idx) = tryIdx tup i - | otherwise = throwResumable @(ValueError location (Value location)) (IndexError arr idx) + | otherwise = throwValueError (IndexError arr idx) liftNumeric f arg | Just (Integer (Number.Integer i)) <- prjValue arg = integer $ f i From 713b3ac290b8660d32286e6966b206535a49f1ac Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Mon, 30 Apr 2018 16:56:50 -0400 Subject: [PATCH 5/5] Ensure we can typecheck tuple accesses. --- src/Data/Abstract/Type.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/Data/Abstract/Type.hs b/src/Data/Abstract/Type.hs index f68e673b8..c070ec4d0 100644 --- a/src/Data/Abstract/Type.hs +++ b/src/Data/Abstract/Type.hs @@ -125,8 +125,9 @@ instance ( Alternative (m effects) isHole ty = pure (ty == Hole) - index (Array (mem:_)) Int = pure mem - index a b = throwResumable (SubscriptError a b) + index (Array (mem:_)) Int = pure mem + index (Product (mem:_)) Int = pure mem + index a b = throwResumable (SubscriptError a b) ifthenelse cond if' else' = unify cond Bool *> (if' <|> else')