Merge pull request #2124 from github/eval-instances

add evaluatable instances for sequence expression, void and delete

src/Control/Abstract/Heap.hs

@@ -8,6 +8,7 @@ module Control.Abstract.Heap
 , putHeap
 , box
 , alloc
+, dealloc
 , deref
 , assign
 , letrec
@@ -16,7 +17,7 @@ module Control.Abstract.Heap
 -- * Garbage collection
 , gc
 -- * Effects
-, Allocator(..)
+, Allocator
 , runAllocator
 , Deref(..)
 , runDeref
@@ -70,6 +71,9 @@ box val = do
 alloc :: Member (Allocator address value) effects => Name -> Evaluator address value effects address
 alloc = sendAllocator . Alloc
 
+dealloc :: Member (Allocator address value) effects => address -> Evaluator address value effects ()
+dealloc = sendAllocator . Delete
+
 -- | Dereference the given address in the heap, or fail if the address is uninitialized.
 deref :: Member (Deref address value) effects => address -> Evaluator address value effects value
 deref = send . Deref
@@ -160,6 +164,7 @@ data Allocator address value (m :: * -> *) return where
   Alloc  :: Name             -> Allocator address value m address
   Assign :: address -> value -> Allocator address value m ()
   GC     :: Live address     -> Allocator address value m ()
+  Delete :: address          -> Allocator address value m ()
 
 data Deref address value (m :: * -> *) return where
   Deref  :: address          -> Deref address value m value
@@ -179,6 +184,7 @@ runAllocator = interpret $ \ eff -> case eff of
     cell <- assignCell addr value (fromMaybe mempty (heapLookup addr heap))
     putHeap (heapInit addr cell heap)
   GC roots -> modifyHeap (heapRestrict <*> reachable roots)
+  Delete addr -> modifyHeap (heapDelete addr)
 
 runDeref :: ( Derefable address effects
             , PureEffects effects
@@ -198,6 +204,7 @@ instance Effect (Allocator address value) where
   handleState c dist (Request (Alloc name) k) = Request (Alloc name) (dist . (<$ c) . k)
   handleState c dist (Request (Assign addr value) k) = Request (Assign addr value) (dist . (<$ c) . k)
   handleState c dist (Request (GC roots) k) = Request (GC roots) (dist . (<$ c) . k)
+  handleState c dist (Request (Delete addr) k) = Request (Delete addr) (dist . (<$ c) . k)
 
 instance PureEffect (Deref address value)
 

src/Data/Abstract/Heap.hs

@@ -4,6 +4,7 @@ module Data.Abstract.Heap
   , heapLookup
   , heapLookupAll
   , heapInsert
+  , heapDelete
   , heapInit
   , heapSize
   , heapRestrict
@@ -42,6 +43,8 @@ heapSize = Monoidal.size . unHeap
 heapRestrict :: Ord address => Heap address value -> Live address -> Heap address value
 heapRestrict (Heap m) roots = Heap (Monoidal.filterWithKey (\ address _ -> address `liveMember` roots) m)
 
+heapDelete :: Ord address => address -> Heap address value -> Heap address value
+heapDelete addr = Heap . Monoidal.delete addr . unHeap
 
 instance (Ord address, Ord value) => Reducer (address, value) (Heap address value) where
   unit = Heap . unit

src/Data/Map/Monoidal.hs

@@ -6,6 +6,7 @@ module Data.Map.Monoidal
 , singleton
 , size
 , insert
+, delete
 , filterWithKey
 , pairs
 , keys
@@ -35,6 +36,9 @@ size = Map.size . unMap
 insert :: Ord key => key -> value -> Map key value -> Map key value
 insert key value = Map . Map.insert key value . unMap
 
+delete :: Ord key => key -> Map key value -> Map key value
+delete key = Map . Map.delete key . unMap
+
 filterWithKey :: (key -> value -> Bool) -> Map key value -> Map key value
 filterWithKey f = Map . Map.filterWithKey f . unMap
 

src/Data/Syntax/Expression.hs

@@ -6,8 +6,9 @@ import Data.Abstract.Evaluatable hiding (Member)
 import Data.Abstract.Number (liftIntegralFrac, liftReal, liftedExponent, liftedFloorDiv)
 import Data.Fixed
 import Data.JSON.Fields
-import Diffing.Algorithm
-import Prologue hiding (index, Member, This)
+import Diffing.Algorithm hiding (Delete)
+import Prologue hiding (index, Member, This, null)
+import Prelude hiding (null)
 import Proto3.Suite.Class
 
 -- | Typical prefix function application, like `f(x)` in many languages, or `f x` in Haskell.
@@ -272,8 +273,12 @@ instance Ord1 Delete where liftCompare = genericLiftCompare
 instance Show1 Delete where liftShowsPrec = genericLiftShowsPrec
 
 -- TODO: Implement Eval instance for Delete
-instance Evaluatable Delete
-
+instance Evaluatable Delete where
+  eval (Delete a) = do
+    valueRef <- subtermRef a
+    addr <- address valueRef
+    dealloc addr
+    rvalBox unit
 
 -- | A sequence expression such as Javascript or C's comma operator.
 data SequenceExpression a = SequenceExpression { firstExpression :: !a, secondExpression :: !a }
@@ -284,8 +289,9 @@ instance Ord1 SequenceExpression where liftCompare = genericLiftCompare
 instance Show1 SequenceExpression where liftShowsPrec = genericLiftShowsPrec
 
 -- TODO: Implement Eval instance for SequenceExpression
-instance Evaluatable SequenceExpression
-
+instance Evaluatable SequenceExpression where
+  eval (SequenceExpression a b) =
+    subtermValue a >> subtermRef b
 
 -- | Javascript void operator
 newtype Void a = Void { value :: a }
@@ -296,8 +302,9 @@ instance Ord1 Void where liftCompare = genericLiftCompare
 instance Show1 Void where liftShowsPrec = genericLiftShowsPrec
 
 -- TODO: Implement Eval instance for Void
-instance Evaluatable Void
-
+instance Evaluatable Void where
+  eval (Void a) =
+    subtermValue a >> rvalBox null
 
 -- | Javascript typeof operator
 newtype Typeof a = Typeof { value :: a }

src/Language/Python/Assignment.hs

@@ -48,7 +48,6 @@ type Syntax =
    , Declaration.Comprehension
    , Declaration.Decorator
    , Declaration.Function
-   , Declaration.Variable
    , Expression.Plus
    , Expression.Minus
    , Expression.Times

test/Analysis/TypeScript/Spec.hs

@@ -46,6 +46,29 @@ spec config = parallel $ do
         Right (Just (Module _ (_, addr) :| [])) -> heapLookupAll addr heap `shouldBe` Just [Value.Float (Number.Decimal 123.0)]
         other -> expectationFailure (show other)
 
+    it "evaluates sequence expressions" $ do
+      (_, (heap, res)) <- evaluate ["sequence-expression.ts"]
+      case ModuleTable.lookup "sequence-expression.ts" <$> res of
+        Right (Just (Module _ (env, addr) :| [])) -> do
+          Env.names env `shouldBe` [ "x" ]
+          (derefQName heap ("x" :| []) env) `shouldBe` Just (Value.Float (Number.Decimal 3.0))
+        other -> expectationFailure (show other)
+
+    it "evaluates void expressions" $ do
+      (_, (heap, res)) <- evaluate ["void.ts"]
+      case ModuleTable.lookup "void.ts" <$> res of
+        Right (Just (Module _ (_, addr) :| [])) -> heapLookupAll addr heap `shouldBe` Just [Null]
+        other -> expectationFailure (show other)
+
+    it "evaluates delete" $ do
+      (_, (heap, res)) <- evaluate ["delete.ts"]
+      case ModuleTable.lookup "delete.ts" <$> res of
+        Right (Just (Module _ (env, addr) :| [])) -> do
+          heapLookupAll addr heap `shouldBe` Just [Unit]
+          (derefQName heap ("x" :| []) env) `shouldBe` Nothing
+          Env.names env `shouldBe` [ "x" ]
+        other -> expectationFailure (show other)
+
   where
     fixtures = "test/fixtures/typescript/analysis/"
     evaluate = evalTypeScriptProject . map (fixtures <>)

test/fixtures/python/corpus/comparison-operator.diffB-A.txt

@@ -15,10 +15,12 @@
 {+(GreaterThan
   {+(Identifier)+}
   {+(Identifier)+})+}
-{+(Not
-  {+(Equal
-    {+(Identifier)+}
-    {+(Identifier)+})+})+}
+  (Not
+    (Equal
+    { (Identifier)
+    ->(Identifier) }
+    { (Identifier)
+    ->(Identifier) }))
 {+(Member
   {+(Identifier)+}
   {+(Identifier)+})+}
@@ -29,12 +31,10 @@
   {+(Member
     {+(Identifier)+}
     {+(Identifier)+})+})+}
-  (Not
-    (Equal
-    { (Identifier)
-    ->(Identifier) }
-    { (Identifier)
-    ->(Identifier) }))
+{+(Not
+  {+(Equal
+    {+(Identifier)+}
+    {+(Identifier)+})+})+}
 {-(Not
   {-(Member
     {-(Identifier)-}

test/fixtures/python/corpus/exec-statement.diffA-B.txt

@@ -1,28 +1,21 @@
 (Statements
-{+(Call
-  {+(Identifier)+}
-  {+(TextElement)+}
-  {+(Identifier)+}
-  {+(Empty)+})+}
-{+(Call
-  {+(Identifier)+}
-  {+(TextElement)+}
-  {+(Identifier)+}
-  {+(Identifier)+}
-  {+(Empty)+})+}
   (Call
     (Identifier)
   { (TextElement)
   ->(TextElement) }
+  {+(Identifier)+}
     (Empty))
-{-(Call
-  {-(Identifier)-}
-  {-(TextElement)-}
+  (Call
+    (Identifier)
+    (TextElement)
+  {+(Identifier)+}
+  {+(Identifier)+}
   {-(Null)-}
-  {-(Empty)-})-}
-{-(Call
-  {-(Identifier)-}
-  {-(TextElement)-}
+    (Empty))
+  (Call
+    (Identifier)
+  { (TextElement)
+  ->(TextElement) }
   {-(Identifier)-}
   {-(Identifier)-}
-  {-(Empty)-})-})
+    (Empty)))

test/fixtures/python/corpus/exec-statement.diffB-A.txt

@@ -1,22 +1,21 @@
 (Statements
-{+(Call
-  {+(Identifier)+}
-  {+(TextElement)+}
-  {+(Empty)+})+}
+  (Call
+    (Identifier)
+  { (TextElement)
+  ->(TextElement) }
+  {-(Identifier)-}
+    (Empty))
   (Call
     (Identifier)
     (TextElement)
   {+(Null)+}
+  {-(Identifier)-}
   {-(Identifier)-}
     (Empty))
   (Call
     (Identifier)
-    (TextElement)
+  { (TextElement)
+  ->(TextElement) }
   {+(Identifier)+}
-    (Identifier)
-  {-(Identifier)-}
-    (Empty))
-{-(Call
-  {-(Identifier)-}
-  {-(TextElement)-}
-  {-(Empty)-})-})
+  {+(Identifier)+}
+    (Empty)))

test/fixtures/python/corpus/float.diffA-B.txt

@@ -6,14 +6,14 @@
 ->(Float) }
 {+(Float)+}
 {+(Float)+}
-{+(Float)+}
-{+(Float)+}
 { (Float)
 ->(Float) }
 {+(Float)+}
 {+(Float)+}
 {+(Float)+}
-{-(Float)-}
+{ (Float)
+->(Float) }
+{+(Float)+}
 {-(Float)-}
 {-(Float)-}
 {-(Float)-}

test/fixtures/python/corpus/float.diffB-A.txt

@@ -12,8 +12,8 @@
 {+(Float)+}
 {+(Float)+}
 {+(Float)+}
-{ (Float)
-->(Float) }
+{+(Float)+}
+{-(Float)-}
 {-(Float)-}
 {-(Float)-}
 {-(Float)-}

test/fixtures/python/corpus/import-from-statement.diffA-B.txt

@@ -3,10 +3,10 @@
 {+(Import)+}
 {+(Import)+}
 {+(Import)+}
-{ (Import)
-->(Import) }
+{+(Import)+}
 {+(Import)+}
 {-(Import)-}
 {-(Import)-}
 {-(Import)-}
+{-(Import)-}
 {-(Import)-})

test/fixtures/python/corpus/import-from-statement.diffB-A.txt

@@ -1,7 +1,6 @@
 (Statements
 {+(Import)+}
-{ (Import)
-->(Import) }
+{+(Import)+}
 {+(Import)+}
 {+(Import)+}
 { (Import)
@@ -9,4 +8,5 @@
 {-(Import)-}
 {-(Import)-}
 {-(Import)-}
+{-(Import)-}
 {-(Import)-})

test/fixtures/python/corpus/integer.diffA-B.txt

@@ -8,6 +8,8 @@
 {+(Integer)+}
 {+(Negate
   {+(Integer)+})+}
+{ (Integer)
+->(Integer) }
 {+(Integer)+}
 {+(Integer)+}
 {+(Integer)+}
@@ -15,8 +17,6 @@
 {+(Integer)+}
 {+(Integer)+}
 {+(Integer)+}
-{+(Integer)+}
-{-(Integer)-}
 {-(Integer)-}
 {-(Negate
   {-(Integer)-})-}

test/fixtures/python/corpus/integer.diffB-A.txt

@@ -8,6 +8,7 @@
 {+(Integer)+}
 {+(Negate
   {+(Integer)+})+}
+{+(Integer)+}
 { (Integer)
 ->(Integer) }
 {+(Integer)+}
@@ -16,7 +17,6 @@
 {+(Integer)+}
 {+(Integer)+}
 {+(Integer)+}
-{+(Integer)+}
 {-(Integer)-}
 {-(Negate
   {-(Integer)-})-}

test/fixtures/python/corpus/string.diffA-B.txt

@@ -1,12 +1,12 @@
 (Statements
 {+(TextElement)+}
   (TextElement)
-{+(TextElement)+}
-{+(TextElement)+}
 { (TextElement)
 ->(TextElement) }
 {+(TextElement)+}
 {+(TextElement)+}
+{+(TextElement)+}
+{+(TextElement)+}
 {-(TextElement)-}
 {-(TextElement)-}
 {-(TextElement)-}

test/fixtures/python/corpus/string.diffB-A.txt

@@ -1,13 +1,13 @@
 (Statements
 {-(TextElement)-}
   (TextElement)
-{+(TextElement)+}
 { (TextElement)
 ->(TextElement) }
 {+(TextElement)+}
 {+(TextElement)+}
 {+(TextElement)+}
 {+(TextElement)+}
+{+(TextElement)+}
 {-(TextElement)-}
 {-(TextElement)-}
 {-(TextElement)-}

test/fixtures/python/corpus/unary-operator.diffB-A.txt

@@ -2,9 +2,10 @@
 {+(Negate
   {+(Identifier)+})+}
 {+(Identifier)+}
-  (Complement
-  { (Identifier)
-  ->(Identifier) })
+{+(Complement
+  {+(Identifier)+})+}
+{-(Complement
+  {-(Identifier)-})-}
 {-(Negate
   {-(Identifier)-})-}
 {-(Identifier)-})

test/fixtures/typescript/analysis/delete.ts

@@ -0,0 +1,2 @@
+x = 3;
+delete x;

test/fixtures/typescript/analysis/sequence-expression.ts

@@ -0,0 +1 @@
+x = (2,3);

test/fixtures/typescript/analysis/void.ts

@@ -0,0 +1,5 @@
+function foo() {
+  return "hi";
+}
+
+void foo();