1
1
mirror of https://github.com/github/semantic.git synced 2024-12-25 07:55:12 +03:00

Merge branch 'master' into source-aware-reprinter

This commit is contained in:
Patrick Thomson 2018-08-23 18:32:58 -04:00 committed by GitHub
commit 0d4aaef985
16 changed files with 130 additions and 11 deletions

View File

@ -97,6 +97,10 @@ class Show value => AbstractIntro value where
-- --
-- This allows us to abstract the choice of whether to evaluate under binders for different value types. -- This allows us to abstract the choice of whether to evaluate under binders for different value types.
class AbstractIntro value => AbstractValue address value effects where class AbstractIntro value => AbstractValue address value effects where
-- | Cast numbers to integers
castToInteger :: value -> Evaluator address value effects value
-- | Lift a unary operator over a 'Num' to a function on 'value's. -- | Lift a unary operator over a 'Num' to a function on 'value's.
liftNumeric :: (forall a . Num a => a -> a) liftNumeric :: (forall a . Num a => a -> a)
-> (value -> Evaluator address value effects value) -> (value -> Evaluator address value effects value)
@ -121,6 +125,8 @@ class AbstractIntro value => AbstractValue address value effects where
liftBitwise2 :: (forall a . (Integral a, Bits a) => a -> a -> a) liftBitwise2 :: (forall a . (Integral a, Bits a) => a -> a -> a)
-> (value -> value -> Evaluator address value effects value) -> (value -> value -> Evaluator address value effects value)
unsignedRShift :: value -> value -> Evaluator address value effects value
-- | Construct an N-ary tuple of multiple (possibly-disjoint) values -- | Construct an N-ary tuple of multiple (possibly-disjoint) values
tuple :: [address] -> Evaluator address value effects value tuple :: [address] -> Evaluator address value effects value

View File

@ -90,6 +90,10 @@ instance ( Member (Allocator address) effects
liftBitwise _ _ = pure Abstract liftBitwise _ _ = pure Abstract
liftBitwise2 _ _ _ = pure Abstract liftBitwise2 _ _ _ = pure Abstract
unsignedRShift _ _ = pure Abstract
liftComparison _ _ _ = pure Abstract liftComparison _ _ _ = pure Abstract
loop f = f empty loop f = f empty
castToInteger _ = pure Abstract

View File

@ -16,11 +16,13 @@ import Data.Abstract.Environment (Environment, Bindings, EvalContext(..))
import qualified Data.Abstract.Environment as Env import qualified Data.Abstract.Environment as Env
import Data.Abstract.Name import Data.Abstract.Name
import qualified Data.Abstract.Number as Number import qualified Data.Abstract.Number as Number
import Data.Bits
import Data.Coerce import Data.Coerce
import Data.List (genericIndex, genericLength) import Data.List (genericIndex, genericLength)
import Data.Scientific (Scientific) import Data.Scientific (Scientific, coefficient, normalize)
import Data.Scientific.Exts import Data.Scientific.Exts
import qualified Data.Set as Set import qualified Data.Set as Set
import Data.Word
import Prologue import Prologue
data Value address body data Value address body
@ -156,6 +158,7 @@ instance ( Coercible body (Eff effects)
, Member (Resumable (BaseError (ValueError address body))) effects , Member (Resumable (BaseError (ValueError address body))) effects
, Member (Resumable (BaseError (AddressError address (Value address body)))) effects , Member (Resumable (BaseError (AddressError address (Value address body)))) effects
, Member (State (Heap address (Value address body))) effects , Member (State (Heap address (Value address body))) effects
, Member Trace effects
, Ord address , Ord address
, Show address , Show address
) )
@ -273,11 +276,24 @@ instance ( Coercible body (Eff effects)
| otherwise = throwValueError (Bitwise2Error left right) | otherwise = throwValueError (Bitwise2Error left right)
where pair = (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 loop x = catchLoopControl (fix x) (\ control -> case control of
Break value -> deref value 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. -- 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.
Continue _ -> loop x) Continue _ -> loop x)
castToInteger (Integer (Number.Integer i)) = pure (Integer (Number.Integer i))
castToInteger (Float (Number.Decimal i)) = pure (Integer (Number.Integer (coefficient (normalize i))))
castToInteger i = throwValueError (NumericError i)
-- | The type of exceptions that can be thrown when constructing values in 'Value's 'MonadValue' instance. -- | The type of exceptions that can be thrown when constructing values in 'Value's 'MonadValue' instance.
data ValueError address body resume where data ValueError address body resume where

View File

@ -331,6 +331,8 @@ instance ( Member (Allocator address) effects
liftBitwise _ = unify Int liftBitwise _ = unify Int
liftBitwise2 _ t1 t2 = unify Int t1 >>= flip unify t2 liftBitwise2 _ t1 t2 = unify Int t1 >>= flip unify t2
unsignedRShift t1 t2 = unify Int t2 *> unify Int t1
liftComparison (Concrete _) left right = case (left, right) of liftComparison (Concrete _) left right = case (left, right) of
(Float, Int) -> pure Bool (Float, Int) -> pure Bool
(Int, Float) -> pure Bool (Int, Float) -> pure Bool
@ -341,3 +343,5 @@ instance ( Member (Allocator address) effects
_ -> unify left right $> Bool _ -> unify left right $> Bool
loop f = f empty loop f = f empty
castToInteger t = unify t (Int :+ Float :+ Rational) $> Int

View File

@ -4,6 +4,7 @@ module Data.Syntax.Expression where
import Data.Abstract.Evaluatable hiding (Member) import Data.Abstract.Evaluatable hiding (Member)
import Data.Abstract.Number (liftIntegralFrac, liftReal, liftedExponent, liftedFloorDiv) import Data.Abstract.Number (liftIntegralFrac, liftReal, liftedExponent, liftedFloorDiv)
import Data.Bits
import Data.Fixed import Data.Fixed
import Data.JSON.Fields import Data.JSON.Fields
import Diffing.Algorithm hiding (Delete) import Diffing.Algorithm hiding (Delete)
@ -272,7 +273,6 @@ instance Eq1 Delete where liftEq = genericLiftEq
instance Ord1 Delete where liftCompare = genericLiftCompare instance Ord1 Delete where liftCompare = genericLiftCompare
instance Show1 Delete where liftShowsPrec = genericLiftShowsPrec instance Show1 Delete where liftShowsPrec = genericLiftShowsPrec
-- TODO: Implement Eval instance for Delete
instance Evaluatable Delete where instance Evaluatable Delete where
eval (Delete a) = do eval (Delete a) = do
valueRef <- subtermRef a valueRef <- subtermRef a
@ -288,7 +288,6 @@ instance Eq1 SequenceExpression where liftEq = genericLiftEq
instance Ord1 SequenceExpression where liftCompare = genericLiftCompare instance Ord1 SequenceExpression where liftCompare = genericLiftCompare
instance Show1 SequenceExpression where liftShowsPrec = genericLiftShowsPrec instance Show1 SequenceExpression where liftShowsPrec = genericLiftShowsPrec
-- TODO: Implement Eval instance for SequenceExpression
instance Evaluatable SequenceExpression where instance Evaluatable SequenceExpression where
eval (SequenceExpression a b) = eval (SequenceExpression a b) =
subtermValue a >> subtermRef b subtermValue a >> subtermRef b
@ -301,7 +300,6 @@ instance Eq1 Void where liftEq = genericLiftEq
instance Ord1 Void where liftCompare = genericLiftCompare instance Ord1 Void where liftCompare = genericLiftCompare
instance Show1 Void where liftShowsPrec = genericLiftShowsPrec instance Show1 Void where liftShowsPrec = genericLiftShowsPrec
-- TODO: Implement Eval instance for Void
instance Evaluatable Void where instance Evaluatable Void where
eval (Void a) = eval (Void a) =
subtermValue a >> rvalBox null subtermValue a >> rvalBox null
@ -325,6 +323,10 @@ instance Eq1 BOr where liftEq = genericLiftEq
instance Ord1 BOr where liftCompare = genericLiftCompare instance Ord1 BOr where liftCompare = genericLiftCompare
instance Show1 BOr where liftShowsPrec = genericLiftShowsPrec instance Show1 BOr where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable BOr where instance Evaluatable BOr where
eval (BOr a b) = do
a' <- subtermValue a >>= castToInteger
b' <- subtermValue b >>= castToInteger
liftBitwise2 (.|.) a' b' >>= rvalBox
data BAnd a = BAnd { left :: a, right :: a } data BAnd a = BAnd { left :: a, right :: a }
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, Named1, Message1) deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, Named1, Message1)
@ -333,6 +335,11 @@ instance Eq1 BAnd where liftEq = genericLiftEq
instance Ord1 BAnd where liftCompare = genericLiftCompare instance Ord1 BAnd where liftCompare = genericLiftCompare
instance Show1 BAnd where liftShowsPrec = genericLiftShowsPrec instance Show1 BAnd where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable BAnd where instance Evaluatable BAnd where
eval (BAnd a b) = do
a' <- subtermValue a >>= castToInteger
b' <- subtermValue b >>= castToInteger
liftBitwise2 (.&.) a' b' >>= rvalBox
data BXOr a = BXOr { left :: a, right :: a } data BXOr a = BXOr { left :: a, right :: a }
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, Named1, Message1) deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, Named1, Message1)
@ -341,6 +348,10 @@ instance Eq1 BXOr where liftEq = genericLiftEq
instance Ord1 BXOr where liftCompare = genericLiftCompare instance Ord1 BXOr where liftCompare = genericLiftCompare
instance Show1 BXOr where liftShowsPrec = genericLiftShowsPrec instance Show1 BXOr where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable BXOr where instance Evaluatable BXOr where
eval (BXOr a b) = do
a' <- subtermValue a >>= castToInteger
b' <- subtermValue b >>= castToInteger
liftBitwise2 xor a' b' >>= rvalBox
data LShift a = LShift { left :: a, right :: a } data LShift a = LShift { left :: a, right :: a }
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, Named1, Message1) deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, Named1, Message1)
@ -349,6 +360,12 @@ instance Eq1 LShift where liftEq = genericLiftEq
instance Ord1 LShift where liftCompare = genericLiftCompare instance Ord1 LShift where liftCompare = genericLiftCompare
instance Show1 LShift where liftShowsPrec = genericLiftShowsPrec instance Show1 LShift where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable LShift where instance Evaluatable LShift where
eval (LShift a b) = do
a' <- subtermValue a >>= castToInteger
b' <- subtermValue b >>= castToInteger
liftBitwise2 shiftL' a' b' >>= rvalBox
where
shiftL' a b = shiftL a (fromIntegral (toInteger b))
data RShift a = RShift { left :: a, right :: a } data RShift a = RShift { left :: a, right :: a }
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, Named1, Message1) deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, Named1, Message1)
@ -357,6 +374,12 @@ instance Eq1 RShift where liftEq = genericLiftEq
instance Ord1 RShift where liftCompare = genericLiftCompare instance Ord1 RShift where liftCompare = genericLiftCompare
instance Show1 RShift where liftShowsPrec = genericLiftShowsPrec instance Show1 RShift where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable RShift where instance Evaluatable RShift where
eval (RShift a b) = do
a' <- subtermValue a >>= castToInteger
b' <- subtermValue b >>= castToInteger
liftBitwise2 shiftR' a' b' >>= rvalBox
where
shiftR' a b = shiftR a (fromIntegral (toInteger b))
data UnsignedRShift a = UnsignedRShift { left :: a, right :: a } data UnsignedRShift a = UnsignedRShift { left :: a, right :: a }
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, Named1, Message1) deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, Named1, Message1)
@ -365,6 +388,10 @@ instance Eq1 UnsignedRShift where liftEq = genericLiftEq
instance Ord1 UnsignedRShift where liftCompare = genericLiftCompare instance Ord1 UnsignedRShift where liftCompare = genericLiftCompare
instance Show1 UnsignedRShift where liftShowsPrec = genericLiftShowsPrec instance Show1 UnsignedRShift where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable UnsignedRShift where instance Evaluatable UnsignedRShift where
eval (UnsignedRShift a b) = do
a' <- subtermValue a >>= castToInteger
b' <- subtermValue b >>= castToInteger
unsignedRShift a' b' >>= rvalBox
newtype Complement a = Complement { value :: a } newtype Complement a = Complement { value :: a }
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, Named1, Message1) deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, Named1, Message1)
@ -374,6 +401,9 @@ instance Ord1 Complement where liftCompare = genericLiftCompare
instance Show1 Complement where liftShowsPrec = genericLiftShowsPrec instance Show1 Complement where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable Complement where instance Evaluatable Complement where
eval (Complement a) = do
a' <- subtermValue a >>= castToInteger
liftBitwise complement a' >>= rvalBox
-- | Member Access (e.g. a.b) -- | Member Access (e.g. a.b)
data MemberAccess a = MemberAccess { lhs :: a, rhs :: Name } data MemberAccess a = MemberAccess { lhs :: a, rhs :: Name }
@ -469,9 +499,10 @@ instance Eq1 Await where liftEq = genericLiftEq
instance Ord1 Await where liftCompare = genericLiftCompare instance Ord1 Await where liftCompare = genericLiftCompare
instance Show1 Await where liftShowsPrec = genericLiftShowsPrec instance Show1 Await where liftShowsPrec = genericLiftShowsPrec
-- TODO: Implement Eval instance for Await -- TODO: Improve this to model asynchrony or capture some data suggesting async calls are not a problem.
instance Evaluatable Await -- We are currently dealing with an asynchronous construct synchronously.
instance Evaluatable Await where
eval (Await a) = subtermRef a
-- | An object constructor call in Javascript, Java, etc. -- | An object constructor call in Javascript, Java, etc.
newtype New a = New { newSubject :: [a] } newtype New a = New { newSubject :: [a] }
@ -492,7 +523,6 @@ instance Eq1 Cast where liftEq = genericLiftEq
instance Ord1 Cast where liftCompare = genericLiftCompare instance Ord1 Cast where liftCompare = genericLiftCompare
instance Show1 Cast where liftShowsPrec = genericLiftShowsPrec instance Show1 Cast where liftShowsPrec = genericLiftShowsPrec
-- TODO: Implement Eval instance for Cast
instance Evaluatable Cast instance Evaluatable Cast
data Super a = Super data Super a = Super
@ -501,7 +531,8 @@ data Super a = Super
instance Eq1 Super where liftEq = genericLiftEq instance Eq1 Super where liftEq = genericLiftEq
instance Ord1 Super where liftCompare = genericLiftCompare instance Ord1 Super where liftCompare = genericLiftCompare
instance Show1 Super where liftShowsPrec = genericLiftShowsPrec instance Show1 Super where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable Super instance Evaluatable Super where
eval Super = Rval <$> (maybeM (box unit) =<< self)
data This a = This data This a = This
deriving (Diffable, Eq, Foldable, Functor, Generic1, Ord, Show, Traversable, FreeVariables1, Declarations1, ToJSONFields1, Hashable1, Named1, Message1) deriving (Diffable, Eq, Foldable, Functor, Generic1, Ord, Show, Traversable, FreeVariables1, Declarations1, ToJSONFields1, Hashable1, Named1, Message1)

View File

@ -295,7 +295,8 @@ awaitExpression = makeTerm <$> symbol Grammar.AwaitExpression <*> children (Expr
unaryExpression :: Assignment Term unaryExpression :: Assignment Term
unaryExpression = symbol Grammar.UnaryExpression >>= \ loc -> unaryExpression = symbol Grammar.UnaryExpression >>= \ loc ->
makeTerm loc . Expression.Not <$> children ((symbol AnonTilde <|> symbol AnonBang) *> term expression) makeTerm loc . Expression.Not <$> children (symbol AnonBang *> term expression)
<|> makeTerm loc . Expression.Complement <$> children (symbol AnonTilde *> term expression)
<|> makeTerm loc . Expression.Negate <$> children ((symbol AnonMinus <|> symbol AnonPlus) *> term expression) <|> makeTerm loc . Expression.Negate <$> children ((symbol AnonMinus <|> symbol AnonPlus) *> term expression)
<|> makeTerm loc . Expression.Typeof <$> children (symbol AnonTypeof *> term expression) <|> makeTerm loc . Expression.Typeof <$> children (symbol AnonTypeof *> term expression)
<|> makeTerm loc . Expression.Void <$> children (symbol AnonVoid *> term expression) <|> makeTerm loc . Expression.Void <$> children (symbol AnonVoid *> term expression)

View File

@ -69,6 +69,51 @@ spec config = parallel $ do
Env.names env `shouldBe` [ "x" ] Env.names env `shouldBe` [ "x" ]
other -> expectationFailure (show other) other -> expectationFailure (show other)
it "evaluates await" $ do
(_, (heap, res)) <- evaluate ["await.ts"]
case ModuleTable.lookup "await.ts" <$> res of
Right (Just (Module _ (env, addr) :| [])) -> do
Env.names env `shouldBe` [ "f2" ]
(derefQName heap ("y" :| []) env) `shouldBe` Nothing
other -> expectationFailure (show other)
it "evaluates BOr statements" $ do
(_, (heap, res)) <- evaluate ["bor.ts"]
case ModuleTable.lookup "bor.ts" <$> res of
Right (Just (Module _ (_, addr) :| [])) -> heapLookupAll addr heap `shouldBe` Just [Value.Integer (Number.Integer 3)]
other -> expectationFailure (show other)
it "evaluates BAnd statements" $ do
(_, (heap, res)) <- evaluate ["band.ts"]
case ModuleTable.lookup "band.ts" <$> res of
Right (Just (Module _ (_, addr) :| [])) -> heapLookupAll addr heap `shouldBe` Just [Value.Integer (Number.Integer 0)]
other -> expectationFailure (show other)
it "evaluates BXOr statements" $ do
(_, (heap, res)) <- evaluate ["bxor.ts"]
case ModuleTable.lookup "bxor.ts" <$> res of
Right (Just (Module _ (_, addr) :| [])) -> heapLookupAll addr heap `shouldBe` Just [Value.Integer (Number.Integer 3)]
other -> expectationFailure (show other)
it "evaluates LShift statements" $ do
(_, (heap, res)) <- evaluate ["lshift.ts"]
case ModuleTable.lookup "lshift.ts" <$> res of
Right (Just (Module _ (_, addr) :| [])) -> heapLookupAll addr heap `shouldBe` Just [Value.Integer (Number.Integer 4)]
other -> expectationFailure (show other)
it "evaluates RShift statements" $ do
(_, (heap, res)) <- evaluate ["rshift.ts"]
case ModuleTable.lookup "rshift.ts" <$> res of
Right (Just (Module _ (_, addr) :| [])) -> heapLookupAll addr heap `shouldBe` Just [Value.Integer (Number.Integer 0)]
other -> expectationFailure (show other)
it "evaluates Complement statements" $ do
(_, (heap, res)) <- evaluate ["complement.ts"]
case ModuleTable.lookup "complement.ts" <$> res of
Right (Just (Module _ (_, addr) :| [])) -> heapLookupAll addr heap `shouldBe` Just [Value.Integer (Number.Integer (-2))]
other -> expectationFailure (show other)
where where
fixtures = "test/fixtures/typescript/analysis/" fixtures = "test/fixtures/typescript/analysis/"
evaluate = evalTypeScriptProject . map (fixtures <>) evaluate = evalTypeScriptProject . map (fixtures <>)

View File

@ -0,0 +1,5 @@
async function f2() {
var y = await 20;
return y;
}
f2();

View File

@ -0,0 +1 @@
1 & 2;

View File

@ -0,0 +1 @@
1 | 2;

View File

@ -0,0 +1 @@
1 ^ 2;

View File

@ -0,0 +1 @@
~1;

View File

@ -0,0 +1 @@
1 << 2;

View File

@ -0,0 +1 @@
1 >> 2;

View File

@ -0,0 +1 @@
1 >>> 2;

2
vendor/effects vendored

@ -1 +1 @@
Subproject commit b78e9c6e77c89ab9c338aae9cf2e24d0e5f3abfc Subproject commit 8ded4a64133ce77ddd2fc734f455753e62af0ad3