Implement 'backup' command

data/entities.yaml

@@ -771,6 +771,15 @@
   capabilities: [move, turn, moveheavy]
   properties: [portable]
 
+- name: tape drive
+  display:
+    attr: device
+    char: '%'
+  description:
+  - A "tape drive" allows you to `backup`; that is, to 'drive' in reverse.
+  capabilities: [backup]
+  properties: [portable]
+
 - name: dozer blade
   display:
     attr: silver

data/scenarios/Testing/00-ORDER.txt

@@ -40,3 +40,4 @@
 1356-portals
 144-subworlds
 1379-single-world-portal-reorientation.yaml
+1399-backup-command.yaml

data/scenarios/Testing/1399-backup-command.yaml

@@ -0,0 +1,30 @@
+version: 1
+name: Demo backup command
+description: |
+  Locomote backwards without access to the turn command
+objectives:
+  - goal:
+    - |
+      `grab` the "flower".
+    condition: |
+      as base {has "flower"}
+solution: |
+    backup; backup; grab;
+robots:
+  - name: base
+    dir: [0, 1]
+    devices:
+      - tape drive
+      - grabber
+known: [flower]
+world:
+  default: [blank]
+  palette:
+    '.': [grass]
+    'f': [grass, flower]
+    'B': [grass, null, base]
+  upperleft: [-1, 1]
+  map: |
+    .B.
+    ...
+    .f.

editors/emacs/swarm-mode.el

@@ -54,6 +54,7 @@
                "wait"
                "selfdestruct"
                "move"
+               "backup"
                "push"
                "stride"
                "turn"

editors/vscode/syntaxes/swarm.tmLanguage.json

@@ -58,7 +58,7 @@
 				},
 				{
 				"name": "keyword.other",
-				"match": "\\b(?i)(self|parent|base|if|inl|inr|case|fst|snd|force|undefined|fail|not|format|chars|split|charat|tochar|key|noop|wait|selfdestruct|move|push|stride|turn|grab|harvest|place|give|equip|unequip|make|has|equipped|count|drill|use|build|salvage|reprogram|say|listen|log|view|appear|create|halt|time|scout|whereami|waypoint|detect|resonate|density|sniff|chirp|watch|surveil|heading|blocked|scan|upload|ishere|isempty|meet|meetall|whoami|setname|random|run|return|try|swap|atomic|instant|installkeyhandler|teleport|as|robotnamed|robotnumbered|knows)\\b"
+				"match": "\\b(?i)(self|parent|base|if|inl|inr|case|fst|snd|force|undefined|fail|not|format|chars|split|charat|tochar|key|noop|wait|selfdestruct|move|backup|push|stride|turn|grab|harvest|place|give|equip|unequip|make|has|equipped|count|drill|use|build|salvage|reprogram|say|listen|log|view|appear|create|halt|time|scout|whereami|waypoint|detect|resonate|density|sniff|chirp|watch|surveil|heading|blocked|scan|upload|ishere|isempty|meet|meetall|whoami|setname|random|run|return|try|swap|atomic|instant|installkeyhandler|teleport|as|robotnamed|robotnumbered|knows)\\b"
 				}
 			]
 			},

src/Swarm/Game/Step.hs

@@ -545,6 +545,10 @@ traceLogShow = void . traceLog Logged . from . show
 constCapsFor :: Const -> Robot -> Maybe Capability
 constCapsFor Move r
   | r ^. robotHeavy = Just CMoveheavy
+constCapsFor Backup r
+  | r ^. robotHeavy = Just CMoveheavy
+constCapsFor Stride r
+  | r ^. robotHeavy = Just CMoveheavy
 constCapsFor c _ = constCaps c
 
 -- | Ensure that a robot is capable of executing a certain constant
@@ -1128,17 +1132,11 @@ execConst c vs s k = do
       flagRedraw
       return $ Out VUnit s k
     Move -> do
-      -- Figure out where we're going
-      loc <- use robotLocation
       orient <- use robotOrientation
-      let nextLoc = loc `offsetBy` (orient ? zero)
-      checkMoveAhead nextLoc $
-        MoveFailure
-          { failIfBlocked = ThrowExn
-          , failIfDrown = Destroy
-          }
-      updateRobotLocation loc nextLoc
-      return $ Out VUnit s k
+      moveInDirection $ orient ? zero
+    Backup -> do
+      orient <- use robotOrientation
+      moveInDirection $ applyTurn (DRelative $ DPlanar DBack) $ orient ? zero
     Push -> do
       -- Figure out where we're going
       loc <- use robotLocation
@@ -2467,6 +2465,19 @@ execConst c vs s k = do
       ["You consider destroying your base, but decide not to do it after all."]
       mAch
     selfDestruct .= True
+
+  moveInDirection :: (HasRobotStepState sig m, Has (Lift IO) sig m) => Heading -> m CESK
+  moveInDirection orientation = do
+    -- Figure out where we're going
+    loc <- use robotLocation
+    let nextLoc = loc `offsetBy` orientation
+    checkMoveAhead nextLoc $
+      MoveFailure
+        { failIfBlocked = ThrowExn
+        , failIfDrown = Destroy
+        }
+    updateRobotLocation loc nextLoc
+    return $ Out VUnit s k
 
   -- Make sure nothing is in the way. Note that system robots implicitly ignore
   -- and base throws on failure.

src/Swarm/Language/Capability.hs

@@ -34,6 +34,8 @@ data Capability
     CPower
   | -- | Execute the 'Move' command
     CMove
+  | -- | Execute the 'Backup' command
+    CBackup
   | -- | Execute the 'Push' command
     CPush
   | -- | Execute the 'Stride' command
@@ -207,6 +209,7 @@ constCaps = \case
   Log -> Just CLog
   Selfdestruct -> Just CSelfdestruct
   Move -> Just CMove
+  Backup -> Just CBackup
   Push -> Just CPush
   Stride -> Just CMovemultiple
   Turn -> Just CTurn

src/Swarm/Language/Syntax.hs

@@ -150,6 +150,8 @@ data Const
 
     -- | Move forward one step.
     Move
+  | -- | Move backward one step.
+    Backup
   | -- | Push an entity forward one step.
     Push
   | -- | Move forward multiple steps.
@@ -520,6 +522,7 @@ constInfo c = case c of
       , "This destroys the robot's inventory, so consider `salvage` as an alternative."
       ]
   Move -> command 0 short "Move forward one step."
+  Backup -> command 0 short "Move backward one step."
   Push ->
     command 1 short . doc "Push an entity forward one step." $
       [ "Both entity and robot moves forward one step."

src/Swarm/Language/Typecheck.hs

@@ -713,6 +713,7 @@ inferConst c = case c of
   Noop -> [tyQ| cmd unit |]
   Selfdestruct -> [tyQ| cmd unit |]
   Move -> [tyQ| cmd unit |]
+  Backup -> [tyQ| cmd unit |]
   Push -> [tyQ| cmd unit |]
   Stride -> [tyQ| int -> cmd unit |]
   Turn -> [tyQ| dir -> cmd unit |]

test/integration/Main.hs

@@ -307,6 +307,7 @@ testScenarioSolution rs ui _ci _em =
         , testSolution Default "Testing/144-subworlds/subworld-mapped-robots"
         , testSolution Default "Testing/144-subworlds/subworld-located-robots"
         , testSolution Default "Testing/1379-single-world-portal-reorientation"
+        , testSolution Default "Testing/1399-backup-command"
         ]
     ]
  where