volume command (#1747)

Measures the volume of an enclosed space.
A useful alternative to the `path` command for goal checking.

## Demo

    scripts/play.sh -i data/scenarios/Testing/1747-volume-command.yaml --autoplay --speed 2

data/scenarios/Testing/00-ORDER.txt

@@ -53,4 +53,5 @@ Achievements
 1575-structure-recognizer
 1631-tags.yaml
 1634-message-colors.yaml
-1681-pushable-entity.yaml
+1681-pushable-entity.yaml
+1747-volume-command.yaml

data/scenarios/Testing/1747-volume-command.yaml

@@ -0,0 +1,56 @@
+version: 1
+name: Demo volume command
+description: |
+  Measure volume of enclosed space
+creative: true
+objectives:
+  - goal:
+      - |
+        Make an enclosed volume of 14 cells
+    condition: |
+      as base {
+        let targetVolume = 14 in
+        vol <- volume targetVolume;
+        return $case vol (\_. false) (\x. x == targetVolume);
+      }
+solution: |
+  move;
+  push;
+  turn left;
+  move;
+  turn right;
+  move;
+  turn right;
+  push;
+robots:
+  - name: base
+    dir: east
+    devices:
+      - ADT calculator
+      - treads
+      - dozer blade
+      - logger
+      - branch predictor
+      - comparator
+entities:
+  - name: monolith
+    display:
+      char: '@'
+    description:
+      - Pushable rock
+    properties: [known, unwalkable, pickable]
+known: [mountain]
+world:
+  dsl: |
+    {grass}
+  palette:
+    'B': [grass, null, base]
+    '.': [grass]
+    'A': [stone, mountain]
+    '@': [grass, monolith]
+  upperleft: [-1, 1]
+  map: |
+    AAAAAAAAA
+    A.......A
+    AB.@....A
+    AAAA.AAAA

editors/emacs/swarm-mode.el

@@ -55,6 +55,7 @@
                "selfdestruct"
                "move"
                "backup"
+               "volume"
                "path"
                "push"
                "stride"

editors/vim/swarm.vim

@@ -1,6 +1,6 @@
 syn keyword Keyword def end let in require
 syn keyword Builtins self parent base if inl inr case fst snd force undefined fail not format chars split charat tochar key
-syn keyword Command noop wait selfdestruct move backup path push stride turn grab harvest ignite place ping give equip unequip make has equipped count drill use build salvage reprogram say listen log view appear create halt time scout whereami waypoint structure floorplan hastag tagmembers 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
+syn keyword Command noop wait selfdestruct move backup volume path push stride turn grab harvest ignite place ping give equip unequip make has equipped count drill use build salvage reprogram say listen log view appear create halt time scout whereami waypoint structure floorplan hastag tagmembers 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
 syn keyword Direction east north west south down forward left back right
 syn keyword Type int text dir bool cmd void unit actor
 

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|backup|path|push|stride|turn|grab|harvest|ignite|place|ping|give|equip|unequip|make|has|equipped|count|drill|use|build|salvage|reprogram|say|listen|log|view|appear|create|halt|time|scout|whereami|waypoint|structure|floorplan|hastag|tagmembers|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|volume|path|push|stride|turn|grab|harvest|ignite|place|ping|give|equip|unequip|make|has|equipped|count|drill|use|build|salvage|reprogram|say|listen|log|view|appear|create|halt|time|scout|whereami|waypoint|structure|floorplan|hastag|tagmembers|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-engine/Swarm/Game/Step/Const.hs

@@ -72,6 +72,7 @@ import Swarm.Game.State.Robot
 import Swarm.Game.State.Substate
 import Swarm.Game.Step.Arithmetic
 import Swarm.Game.Step.Combustion qualified as Combustion
+import Swarm.Game.Step.Flood
 import Swarm.Game.Step.Path.Finding
 import Swarm.Game.Step.Path.Type
 import Swarm.Game.Step.Path.Walkability
@@ -157,6 +158,24 @@ execConst runChildProg c vs s k = do
     Backup -> do
       orientation <- use robotOrientation
       moveInDirection $ applyTurn (DRelative $ DPlanar DBack) $ orientation ? zero
+    Volume -> case vs of
+      [VInt limit] -> do
+        when (limit > globalMaxVolume) $
+          throwError $
+            CmdFailed
+              Volume
+              ( T.unwords
+                  [ "Can only measure up to"
+                  , T.pack $ show globalMaxVolume
+                  , "cells."
+                  ]
+              )
+              Nothing
+
+        robotLoc <- use robotLocation
+        maybeResult <- floodFill robotLoc $ fromIntegral limit
+        return $ mkReturn maybeResult
+      _ -> badConst
     Path -> case vs of
       [VInj hasLimit limitVal, VInj findEntity goalVal] -> do
         maybeLimit <-

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

@@ -0,0 +1,110 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+-- |
+-- SPDX-License-Identifier: BSD-3-Clause
+--
+-- Implementation of the 'Swarm.Language.Syntax.Volume' command for robots.
+--
+-- Note: If the robot is currently on an unwalkable cell (which may happen in
+-- the case of teleportation or if an entity is placed or pushed into its cell),
+-- the volume shall be zero.
+module Swarm.Game.Step.Flood (
+  floodFill,
+) where
+
+import Control.Effect.Lens
+import Control.Lens (makeLenses, (%~), (&))
+import Data.HashSet (HashSet)
+import Data.HashSet qualified as HashSet
+import Swarm.Game.Location
+import Swarm.Game.Step.RobotStepState
+import Swarm.Game.Step.Util (checkMoveFailureUnprivileged)
+import Swarm.Game.Step.Util.Inspect (getNeighborLocs)
+import Swarm.Game.Universe
+
+data FloodParms = FloodParms
+  { theSubworld :: SubworldName
+  , maxVisits :: Int
+  }
+
+data Tracking = Tracking
+  { visited :: HashSet Location
+  , floodPartition :: FloodPartition
+  }
+
+-- | We annotate each visited cell as
+-- being part of the boundary or the interior.
+-- This lets us:
+--
+-- 1. Use the interior cell count as a termination condition
+-- 2. Handle (eventual) cache invalidation differently for boundary
+--    members than interior members.
+data FloodPartition = FloodPartition
+  { _boundary :: HashSet Location
+  , _interior :: HashSet Location
+  }
+
+makeLenses ''FloodPartition
+
+-- |
+-- == Algorithm
+--
+-- Explore via DFS using a list as a stack.
+-- Each iteration examines a single cell.
+--
+-- 1. Mark the popped cell as visited, regardless of walkability.
+-- 2. Check popped cell for walkability
+-- 3. Add all neighbors that aren't already visited, regardless of walkability, to the stack.
+--    But unwalkable cells shall not produce neighbors and shall be marked with a boundary/interior distinction.
+floodRecursive ::
+  HasRobotStepState sig m =>
+  Tracking ->
+  [Location] ->
+  FloodParms ->
+  m (Maybe Int)
+floodRecursive tracking pending params =
+  case pending of
+    nextLoc : otherLocs ->
+      if interiorCount > maxVisits params
+        then return Nothing
+        else checkNeighbors nextLoc otherLocs
+    [] -> return $ Just interiorCount
+ where
+  interiorCount = HashSet.size $ _interior $ floodPartition tracking
+  checkNeighbors nextLoc otherLocs = do
+    isWalkable <- null <$> checkMoveFailureUnprivileged cosmicLoc
+    let candidateNeighbors =
+          if isWalkable
+            then map (view planar) $ getNeighborLocs cosmicLoc
+            else []
+        visitableNeighbors = filter (not . (`HashSet.member` visited tracking)) candidateNeighbors
+
+        -- It's cheaper to prepend the "visitableNeighbors" list because
+        -- it should in general be a shorter list than the "pending" list.
+        newPending = visitableNeighbors <> otherLocs
+
+        partitionMutator =
+          if isWalkable
+            then interior
+            else boundary
+        newPartition = floodPartition tracking & partitionMutator %~ HashSet.insert nextLoc
+
+        newTracking =
+          tracking
+            { visited = newVisited
+            , floodPartition = newPartition
+            }
+    floodRecursive newTracking newPending params
+   where
+    newVisited = HashSet.insert nextLoc $ visited tracking
+    cosmicLoc = Cosmic (theSubworld params) nextLoc
+
+floodFill ::
+  HasRobotStepState sig m =>
+  Cosmic Location ->
+  Int ->
+  m (Maybe Int)
+floodFill (Cosmic swn curLoc) =
+  floodRecursive emptyTracking [curLoc] . FloodParms swn
+ where
+  emptyTracking = Tracking mempty $ FloodPartition mempty mempty

src/swarm-lang/Swarm/Language/Capability.hs

@@ -36,6 +36,8 @@ data Capability
     CMove
   | -- | Execute the 'Backup' command
     CBackup
+  | -- | Execute the 'Volume' command
+    CVolume
   | -- | Execute the 'Path' command
     CPath
   | -- | Execute the 'Push' command
@@ -224,6 +226,7 @@ constCaps = \case
   Selfdestruct -> Just CSelfdestruct
   Move -> Just CMove
   Backup -> Just CBackup
+  Volume -> Just CVolume
   Path -> Just CPath
   Push -> Just CPush
   Stride -> Just CMovemultiple

src/swarm-lang/Swarm/Language/Syntax.hs

@@ -37,10 +37,13 @@ module Swarm.Language.Syntax (
   isBuiltinFunction,
   isTangible,
   isLong,
+
+  -- * Size limits
   maxSniffRange,
   maxScoutRange,
   maxStrideRange,
   maxPathRange,
+  globalMaxVolume,
 
   -- * Syntax
   Syntax' (..),
@@ -124,6 +127,15 @@ maxStrideRange = 64
 maxPathRange :: Integer
 maxPathRange = 128
 
+-- | Checked upon invocation of the command,
+-- before flood fill computation, to ensure
+-- the search has a reasonable bound.
+--
+-- The user is warned in the failure message
+-- that there exists a global limit.
+globalMaxVolume :: Integer
+globalMaxVolume = 64 * 64
+
 ------------------------------------------------------------
 -- Constants
 ------------------------------------------------------------
@@ -158,6 +170,8 @@ data Const
     Move
   | -- | Move backward one step.
     Backup
+  | -- | Measure the size of the enclosed volume
+    Volume
   | -- | Describe a path to the destination.
     Path
   | -- | Push an entity forward one step.
@@ -564,6 +578,19 @@ constInfo c = case c of
       shortDoc
         (Set.singleton $ Mutation $ RobotChange PositionChange)
         "Move backward one step."
+  Volume ->
+    command 1 short
+      . doc
+        (Set.singleton $ Query $ Sensing EntitySensing)
+        "Measure enclosed volume."
+      $ [ "Specify the max volume to check for."
+        , "Returns either the measured volume bounded by \"unwalkable\" cells,"
+        , "or `unit` if the search exceeds the limit."
+        , T.unwords
+            [ "There is also an implicit hard-coded maximum of"
+            , T.pack $ show globalMaxVolume
+            ]
+        ]
   Path ->
     command 2 short
       . doc

src/swarm-lang/Swarm/Language/Typecheck.hs

@@ -742,6 +742,7 @@ inferConst c = case c of
   Selfdestruct -> [tyQ| cmd unit |]
   Move -> [tyQ| cmd unit |]
   Backup -> [tyQ| cmd unit |]
+  Volume -> [tyQ| int -> cmd (unit + int) |]
   Path -> [tyQ| (unit + int) -> ((int * int) + text) -> cmd (unit + (dir * int)) |]
   Push -> [tyQ| cmd unit |]
   Stride -> [tyQ| int -> cmd unit |]

swarm.cabal

@@ -286,6 +286,7 @@ library swarm-engine
                       Swarm.Game.Step.Arithmetic
                       Swarm.Game.Step.Combustion
                       Swarm.Game.Step.Const
+                      Swarm.Game.Step.Flood
                       Swarm.Game.Step.Path.Cache
                       Swarm.Game.Step.Path.Cache.DistanceLimit
                       Swarm.Game.Step.Path.Finding
@@ -536,6 +537,7 @@ library
                       , Swarm.Game.Step.Arithmetic
                       , Swarm.Game.Step.Combustion
                       , Swarm.Game.Step.Const
+                      , Swarm.Game.Step.Flood
                       , Swarm.Game.Step.Path.Cache
                       , Swarm.Game.Step.Path.Cache.DistanceLimit
                       , Swarm.Game.Step.Path.Finding

test/integration/Main.hs

@@ -363,6 +363,7 @@ testScenarioSolutions rs ui =
         , testSolution Default "Testing/1399-backup-command"
         , testSolution Default "Testing/1536-custom-unwalkable-entities"
         , testSolution Default "Testing/1631-tags"
+        , testSolution Default "Testing/1747-volume-command"
         , testGroup
             -- Note that the description of the classic world in
             -- data/worlds/classic.yaml (automatically tested to some