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))