diff --git a/src/Data/Abstract/Value/Abstract.hs b/src/Data/Abstract/Value/Abstract.hs index 3c854cf4a..1575f6968 100644 --- a/src/Data/Abstract/Value/Abstract.hs +++ b/src/Data/Abstract/Value/Abstract.hs @@ -81,6 +81,8 @@ instance ( Member (Allocator address Abstract) effects liftBitwise _ _ = pure Abstract liftBitwise2 _ _ _ = pure Abstract + unsignedRShift _ _ = pure Abstract + liftComparison _ _ _ = pure Abstract loop f = f empty diff --git a/src/Data/Abstract/Value/Concrete.hs b/src/Data/Abstract/Value/Concrete.hs index 58e487f10..c52690f4d 100644 --- a/src/Data/Abstract/Value/Concrete.hs +++ b/src/Data/Abstract/Value/Concrete.hs @@ -16,11 +16,13 @@ import Data.Abstract.Environment (Environment, Bindings, EvalContext(..)) import qualified Data.Abstract.Environment as Env import Data.Abstract.Name import qualified Data.Abstract.Number as Number +import Data.Bits import Data.Coerce import Data.List (genericIndex, genericLength) import Data.Scientific (Scientific) import Data.Scientific.Exts import qualified Data.Set as Set +import Data.Word import Prologue data Value address body @@ -261,6 +263,16 @@ instance ( Coercible body (Eff effects) | otherwise = throwValueError (Bitwise2Error left right) where pair = (left, right) + unsignedRShift left right + | (Integer (Number.Integer i), Integer (Number.Integer j)) <- pair = + if i >= 0 then pure . integer $ ourShift (fromIntegral i) (fromIntegral j) + else throwValueError (Bitwise2Error left right) + | otherwise = throwValueError (Bitwise2Error left right) + where + pair = (left, right) + ourShift :: Word64 -> Int -> Integer + ourShift a b = toInteger (shiftR a b) + loop x = catchLoopControl (fix x) (\ control -> case control of Break value -> deref value -- FIXME: Figure out how to deal with this. Ruby treats this as the result of the current block iteration, while PHP specifies a breakout level and TypeScript appears to take a label. diff --git a/src/Data/Syntax/Expression.hs b/src/Data/Syntax/Expression.hs index 618909c4a..15c5dfab1 100644 --- a/src/Data/Syntax/Expression.hs +++ b/src/Data/Syntax/Expression.hs @@ -396,6 +396,7 @@ instance Evaluatable UnsignedRShift where a' <- subtermValue a b' <- subtermValue b unsignedRShift a' b' >>= rvalBox + -- This isn't working for JavaScript newtype Complement a = Complement { value :: a } deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, Named1, Message1) @@ -408,7 +409,6 @@ instance Evaluatable Complement where eval (Complement a) = do a' <- subtermValue a liftBitwise complement a' >>= rvalBox - -- TODO: Differentiate between signed and unsigned -- | Member Access (e.g. a.b) data MemberAccess a = MemberAccess { lhs :: a, rhs :: Name }