Add swap command (#685)

- closes #684
- closes #680

data/entities.yaml

@@ -656,10 +656,27 @@
   - "The 'install' command takes two arguments: the robot
     on which to install a device (which can be at most 1 cell away),
     and the name of the device to install."
-
   capabilities: [grab, give, place, install]
   properties: [portable]
 
+- name: fast grabber
+  display:
+    attr: device
+    char: '≪'
+  description:
+  - A fast grabber is an improved version of the basic grabber - not only
+    can it 'grab', 'place', 'give', and 'install', it can also 'swap'.
+  - The 'swap' command allows the robot to execute grab and place at the
+    same time so that the location where the robot is standing does not
+    become empty.
+  - You can use this to prevent failures where multiple robots
+    are trying to grab, place or scan a given location.
+  - In addition you retain the capability to use the 'atomic' command,
+    with which you can implement other commands that are safe when
+    run in parallel.
+  capabilities: [grab, swap, give, place, install, atomic]
+  properties: [portable]
+
 - name: harvester
   display:
     attr: device
@@ -1000,7 +1017,7 @@
     rock to grab.  However, it is actually possible for the 'grab' to
     fail, if some other robot B snatches the rock right after robot A sensed
     it and before robot A got around to grab it on the next game tick."
-  - This will make robot A very sad and it will crash.
+  - "This will make robot A very sad and it will crash."
   - "To prevent this situation, robot A can wrap the commands in 'atomic', like so:"
   - |
     atomic (b <- ishere "rock"; if b {grab} {})
@@ -1020,4 +1037,3 @@
   - will attempt to move, but if that fails, turn left instead.
   properties: [portable]
   capabilities: [try]
-

data/recipes.yaml

@@ -471,6 +471,12 @@
   out:
   - [1, grabber]
 
+- in:
+  - [2, grabber]
+  - [1, rubber band]
+  out:
+  - [1, fast grabber]
+
 - in:
   - [4, circuit]
   - [1, iron plate]

data/scenarios/Testing/00-ORDER.txt

@@ -10,3 +10,4 @@
 555-teleport-location.yaml
 562-lodestone.yaml
 378-objectives.yaml
+684-swap.yaml

data/scenarios/Testing/684-swap.yaml

@@ -0,0 +1,60 @@
+name: Swap in one tick
+description: |
+  Swapping an entity should be done in one tick.
+  https://github.com/swarm-game/swarm/issues/684
+objectives:
+  - condition: |
+      try {
+        as base {
+          l <- has "lambda";
+          b <- has "bitcoin";
+          return $ l && b
+        }
+      } {
+        return false
+      }
+solution: |
+  swap "bitcoin"; swap "gold coin";
+robots:
+  - name: base
+    loc: [0,0]
+    dir: [1,0]
+    devices:
+      - logger
+      - scanner
+      - grabber
+      - fast grabber
+    inventory:
+      - [1, gold coin]
+      - [1, bitcoin]
+  - name: watcher
+    loc: [0,0]
+    dir: [1,0]
+    system: true
+    devices:
+      - logger
+    program: |
+      def repeat = \c. c; repeat c end;
+      repeat (
+        d <- scan down;
+        case d (\_.
+          say "Fatal error: swap does not work atomically!"
+        ) (\_.
+          return ()
+        )
+      )
+world:
+  default: [blank]
+  palette:
+    '┌': [stone, upper left corner]
+    '┐': [stone, upper right corner]
+    '└': [stone, lower left corner]
+    '┘': [stone, lower right corner]
+    '─': [stone, horizontal wall]
+    '│': [stone, vertical wall]
+    'λ': [grass, lambda]
+  upperleft: [-1, 1]
+  map: |
+    ┌─┐
+    │λ│
+    └─┘

editors/emacs/swarm-mode.el

@@ -81,6 +81,7 @@
                "run"
                "return"
                "try"
+               "swap"
                "atomic"
                "teleport"
                "as"

editors/vscode/CHANGELOG.md

@@ -2,6 +2,9 @@
 
 All notable changes to the "swarm-language" extension will be documented in this file.
 
+## WIP
+- [Highlighter] added `swap` command
+
 ## version 0.0.6
 - [Highlighter] **FIX:** the number pattern now matches properly, previously it broke everything!
 - [Highlighter] added `listen` command

editors/vscode/syntaxes/swarm.tmLanguage.json

@@ -60,7 +60,7 @@
 				},
 				{
 				"name": "keyword.other",
-				"match": "\\b(?i)(self|parent|base|if|inl|inr|case|fst|snd|force|undefined|fail|not|format|noop|wait|selfdestruct|move|turn|grab|harvest|place|give|install|make|has|installed|count|drill|build|salvage|reprogram|say|listen|log|view|appear|create|time|whereami|blocked|scan|upload|ishere|whoami|setname|random|run|return|try|atomic|teleport|as|robotnamed|robotnumbered|knows)\\b"
+				"match": "\\b(?i)(self|parent|base|if|inl|inr|case|fst|snd|force|undefined|fail|not|format|noop|wait|selfdestruct|move|turn|grab|harvest|place|give|install|make|has|installed|count|drill|build|salvage|reprogram|say|listen|log|view|appear|create|time|whereami|blocked|scan|upload|ishere|whoami|setname|random|run|return|try|swap|atomic|teleport|as|robotnamed|robotnumbered|knows)\\b"
 				}
 			]
 			},

src/Swarm/Game/Step.hs

@@ -774,8 +774,23 @@ execConst c vs s k = do
         flagRedraw
         return $ Out VUnit s k
       _ -> badConst
-    Grab -> doGrab False
-    Harvest -> doGrab True
+    Grab -> doGrab Grab'
+    Harvest -> doGrab Harvest'
+    Swap -> case vs of
+      [VText name] -> do
+        loc <- use robotLocation
+        -- Make sure the robot has the thing in its inventory
+        e <- hasInInventoryOrFail name
+        -- Grab
+        r <- doGrab Swap'
+        case r of
+          Out {} -> do
+            -- Place the entity and remove it from the inventory
+            updateEntityAt loc (const (Just e))
+            robotInventory %= delete e
+          _ -> pure ()
+        return r
+      _ -> badConst
     Turn -> case vs of
       [VDir d] -> do
         when (isCardinal d) $ hasCapabilityFor COrient (TDir d)
@@ -785,7 +800,6 @@ execConst c vs s k = do
       _ -> badConst
     Place -> case vs of
       [VText name] -> do
-        inv <- use robotInventory
         loc <- use robotLocation
 
         -- Make sure there's nothing already here
@@ -793,12 +807,7 @@ execConst c vs s k = do
         nothingHere `holdsOrFail` ["There is already an entity here."]
 
         -- Make sure the robot has the thing in its inventory
-        e <-
-          listToMaybe (lookupByName name inv)
-            `isJustOrFail` ["What is", indefinite name <> "?"]
-
-        (E.lookup e inv > 0)
-          `holdsOrFail` ["You don't have", indefinite name, "to place."]
+        e <- hasInInventoryOrFail name
 
         -- Place the entity and remove it from the inventory
         updateEntityAt loc (const (Just e))
@@ -1698,15 +1707,23 @@ execConst c vs s k = do
     [VInt n1, VInt n2] -> (\r -> Out (VInt r) s k) <$> evalArith c n1 n2
     _ -> badConst
 
+  -- Make sure the robot has the thing in its inventory
+  hasInInventoryOrFail :: (Has (Throw Exn) sig m, Has (State Robot) sig m) => Text -> m Entity
+  hasInInventoryOrFail eName = do
+    inv <- use robotInventory
+    e <-
+      listToMaybe (lookupByName eName inv)
+        `isJustOrFail` ["What is", indefinite eName <> "?"]
+    let cmd = T.toLower . T.pack . show $ c
+    (E.lookup e inv > 0)
+      `holdsOrFail` ["You don't have", indefinite eName, "to", cmd <> "."]
+    return e
+
   -- The code for grab and harvest is almost identical, hence factored
   -- out here.
-  doGrab shouldHarvest = do
-    let verb
-          | shouldHarvest = "harvest"
-          | otherwise = "grab"
-        verbed
-          | shouldHarvest = "harvested"
-          | otherwise = "grabbed"
+  doGrab cmd = do
+    let verb = verbGrabbingCmd cmd
+        verbed = verbedGrabbingCmd cmd
 
     -- Ensure there is an entity here.
     loc <- use robotLocation
@@ -1729,7 +1746,7 @@ execConst c vs s k = do
 
     -- Possibly regrow the entity, if it is growable and the 'harvest'
     -- command was used.
-    when ((e `hasProperty` Growable) && shouldHarvest) $ do
+    when ((e `hasProperty` Growable) && cmd == Harvest') $ do
       let GrowthTime (minT, maxT) = (e ^. entityGrowth) ? defaultGrowthTime
 
       createdAt <- getNow
@@ -1754,6 +1771,20 @@ execConst c vs s k = do
 -- Some utility functions
 ------------------------------------------------------------
 
+data GrabbingCmd = Grab' | Harvest' | Swap' deriving (Eq, Show)
+
+verbGrabbingCmd :: GrabbingCmd -> Text
+verbGrabbingCmd = \case
+  Harvest' -> "harvest"
+  Grab' -> "grab"
+  Swap' -> "swap"
+
+verbedGrabbingCmd :: GrabbingCmd -> Text
+verbedGrabbingCmd = \case
+  Harvest' -> "harvested"
+  Grab' -> "grabbed"
+  Swap' -> "swapped"
+
 -- | Give some entities from a parent robot (the robot represented by
 --   the ambient @State Robot@ effect) to a child robot (represented
 --   by the given 'RID') as part of a 'Build' or 'Reprogram' command.

src/Swarm/Language/Capability.hs

@@ -111,6 +111,8 @@ data Capability
     CTeleport
   | -- | Capability to run commands atomically
     CAtomic
+  | -- | Capability to execute swap (grab and place atomically at the same time).
+    CSwap
   | -- | Capabiltiy to do time-related things, like `wait` and get the
     --   current time.
     CTime
@@ -193,6 +195,7 @@ constCaps = \case
   Exp -> Just CArith
   Whoami -> Just CWhoami
   Self -> Just CWhoami
+  Swap -> Just CSwap
   Atomic -> Just CAtomic
   Time -> Just CTime
   Wait -> Just CTime

src/Swarm/Language/Syntax.hs

@@ -355,7 +355,9 @@ data Const
     AppF
   | -- Concurrency
 
-    -- | When executing @atomic c@, a robot will not be interrupted,
+    -- | Swap placed entity with one in inventory. Essentially atomic grab and place.
+    Swap
+  | -- | When executing @atomic c@, a robot will not be interrupted,
     --   that is, no other robots will execute any commands while
     --   the robot is executing @c@.
     Atomic
@@ -637,6 +639,11 @@ constInfo c = case c of
       , "For exaple:"
       , "`f $ g $ h x = f (g (h x))`"
       ]
+  Swap ->
+    command 1 short . doc "Swap placed entity with one in inventory." $
+      [ "This essentially works like atomic grab and place."
+      , "Use this to avoid race conditions where more robots grab, scan or place in one location."
+      ]
   Atomic ->
     command 1 Intangible . doc "Execute a block of commands atomically." $
       [ "When executing `atomic c`, a robot will not be interrupted, that is, no other robots will execute any commands while the robot is executing @c@."

src/Swarm/Language/Typecheck.hs

@@ -525,6 +525,7 @@ inferConst c = case c of
   Format -> [tyQ| a -> text |]
   Concat -> [tyQ| text -> text -> text |]
   AppF -> [tyQ| (a -> b) -> a -> b |]
+  Swap -> [tyQ| text -> cmd text |]
   Atomic -> [tyQ| cmd a -> cmd a |]
   Teleport -> [tyQ| robot -> (int * int) -> cmd () |]
   As -> [tyQ| robot -> {cmd a} -> cmd a |]

test/integration/Main.hs

@@ -200,6 +200,7 @@ testScenarioSolution _ci _em =
         , expectFailBecause "Awaiting fix (#540)" $
             testSolution (Sec 10) "Testing/562-lodestone"
         , testSolution Default "Testing/378-objectives"
+        , testSolution Default "Testing/684-swap"
         ]
     ]
  where