Evaluate argument to instant/atomic atomically, as a special case (…

…#2271)

Since Swarm is strict, the way an application `instant c` works is as follows:

1. Evaluate the LHS `instant` to a value (immediately succeeds since it is just a constant)
2. Evaluate the RHS `c` to a value
3. Perform the function application `instant c`, by atomically executing the command represented by `c`

Usually, step (2) succeeds almost instantly as well.  For example if `c` is something like `move; move; turn right; move` then it just instantly turns into a command value.  However, `c` could be something like `def x = (expensive pure expression) end; other stuff` in which case evaluating `c` will cause the definition of `x` to be (expensively) evaluated.

This PR rectifies the situation by ensuring that not only are `instant`/`atomic` *executed* atomically, but also their argument is *evaluated* atomically.  Fixes #2270.

data/scenarios/Challenges/_gallery/setup.sw

@@ -1,3 +1,5 @@
+instant (
+
 def doN = \n. \f. if (n > 0) {f; doN (n - 1) f} {}; end;
 
 def isDivisibleBy = \dividend. \divisor.
@@ -99,7 +101,7 @@ def length : (rec l. Unit + a * l) -> Int = \l.
 end
 
 def busts : (rec l. Unit + Text * l) = tagmembers "bust" end
-def bustCount : {Int} = {length busts} end
+def bustCount : Int = length busts end
 
 def placeThing = \entIdx.
     let entName = index entIdx busts in
@@ -125,7 +127,7 @@ bust in the base's inventory increases monotonically.
 */
 def populateInventory = \baseCount. \idx.
 
-    if (idx < force bustCount) {
+    if (idx < bustCount) {
 
         let item = index idx busts in
 
@@ -150,14 +152,16 @@ def populateInventory = \baseCount. \idx.
 def setup =
     populateInventory 0 0;
 
-    naiveRandomStack placeEntByIndex (force bustCount) 0 (force bustCount);
+    naiveRandomStack placeEntByIndex bustCount 0 bustCount;
     turn back;
     move;
     create "bitcoin";
     end;
 
 def go =
-    instant setup;
+    setup;
     end;
 
 go;
+
+)

data/scenarios/Testing/00-ORDER.txt

@@ -73,3 +73,4 @@ Achievements
 2239-custom-entity.yaml
 2240-overridden-entity-capabilities.yaml
 2253-halt-waiting.yaml
+2270-instant-defs.yaml

data/scenarios/Testing/2270-instant-defs.yaml

@@ -0,0 +1,42 @@
+version: 1
+name: Instant wrapped defs
+description: |
+  `instant` should work when wrapped around definitions
+creative: false
+objectives:
+  - goal:
+      - Grab the rock
+    condition: |
+      as base { has "rock" }
+robots:
+  - name: base
+    dir: east
+    devices:
+      - logger
+      - treads
+      - grabber
+  - name: judge
+    dir: east
+    system: true
+    program: |
+      instant (
+      def fib : Int -> Int = \n.
+        if (n <= 1) {n} {fib (n-1) + fib (n-2)}
+      end
+
+      def x = fib 10 end
+
+      create "rock"; place "rock"
+      )
+solution: |
+  move; grab
+known: [rock]
+world:
+  dsl: |
+    {grass}
+  palette:
+    'B': [grass, null, base]
+    'j': [grass, null, judge]
+  upperleft: [0, 0]
+  map: |
+    Bj

src/swarm-engine/Swarm/Game/Step.hs

@@ -603,6 +603,32 @@ stepCESK cesk = case cesk of
   Out v2 s (FFst v1 : k) -> return $ Out (VPair v1 v2) s k
   -- Lambdas immediately turn into closures.
   In (TLam x _ t) e s k -> return $ Out (VClo x t e) s k
+  -- Special case for evaluating an application of Instant or Atomic:
+  -- set the runningAtomic flag and push a stack frame to unset it
+  -- when done evaluating.  We do this here so that even /evaluating/
+  -- the argument to instant/atomic will happen atomically (#2270).
+  -- Execution will also happen atomically; that is handled in
+  -- execConst.
+  In (TApp (TConst c) t2) e s k
+    | c `elem` [Atomic, Instant] -> do
+        runningAtomic .= True
+        case k of
+          -- In the (common) special case that we will immediately
+          -- execute the atomic/instant command next, don't bother
+          -- pushing an FFinishAtomic frame. That way, runningAtomic
+          -- will remain set, and evaluation + execution together will
+          -- all happen in a single tick.
+          FExec : _ -> return $ In t2 e s (FApp (VCApp c []) : k)
+          -- Otherwise, in general, other evaluation may take place in
+          -- between evaluating the argument to atomic/instant and
+          -- executing it, so we must push an FFinishAtomic frame so
+          -- that intermediate evaluation will not happen atomically.
+          -- For example, consider something like `f (instant c)`,
+          -- where `f : Cmd Unit -> Cmd Unit`.  After evaluating `c`
+          -- atomically, `instant c` is then passed to `f`, which may
+          -- do some (non-atomic) computation before executing its
+          -- argument (if it is executed at all).
+          _ -> return $ In t2 e s (FApp (VCApp c []) : FFinishAtomic : k)
   -- To evaluate an application, start by focusing on the left-hand
   -- side and saving the argument for later.
   In (TApp t1 t2) e s k -> return $ In t1 e s (FArg t2 e : k)

test/integration/Main.hs

@@ -509,6 +509,7 @@ testScenarioSolutions rs ui key =
           not (any ("- treads" `T.isInfixOf`) msgs)
             && any ("- tank treads" `T.isInfixOf`) msgs
     , testSolution Default "Testing/2253-halt-waiting"
+    , testSolution Default "Testing/2270-instant-defs"
     ]
  where
   -- expectFailIf :: Bool -> String -> TestTree -> TestTree