add instances for unsignedRShift for abstract, type-checking and concrete semantics

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

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.

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 }