volume command

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,65 @@
+-- |
+-- SPDX-License-Identifier: BSD-3-Clause
+--
+-- Implementation of the 'Swarm.Language.Syntax.Volume' command for robots.
+module Swarm.Game.Step.Flood (
+  floodFill,
+) where
+
+import Control.Effect.Lens
+import Control.Monad (filterM)
+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
+  }
+
+floodRecursive ::
+  HasRobotStepState sig m =>
+  HashSet Location ->
+  [Location] ->
+  FloodParms ->
+  m (Maybe Int)
+floodRecursive visited pending st =
+  case pending of
+    nextLoc : otherLocs ->
+      if visitedCount > maxVisits st
+        then return Nothing
+        else checkNeighbors nextLoc otherLocs
+    [] -> return $ Just visitedCount
+ where
+  visitedCount = HashSet.size visited
+  checkNeighbors nextLoc otherLocs = do
+    candidateNeighbors <- listNeighbors $ Cosmic (theSubworld st) nextLoc
+    let visitableNeighbors = filter (not . (`HashSet.member` visited)) candidateNeighbors
+        -- It's cheaper to prepend the "visitableNeighbors" list because
+        -- it should in general be a shorter list than the pending queue.
+        newPending = visitableNeighbors <> otherLocs
+    floodRecursive newVisited newPending st
+   where
+    newVisited = HashSet.insert nextLoc visited
+
+listNeighbors ::
+  HasRobotStepState sig m =>
+  Cosmic Location ->
+  m [Location]
+listNeighbors loc = do
+  locs <- filterM isWalkableLoc $ getNeighborLocs loc
+  return $ map (view planar) locs
+ where
+  isWalkableLoc = fmap null . checkMoveFailureUnprivileged
+
+floodFill ::
+  HasRobotStepState sig m =>
+  Cosmic Location ->
+  Int ->
+  m (Maybe Int)
+floodFill (Cosmic swn curLoc) =
+  floodRecursive mempty [curLoc] . FloodParms swn

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

@@ -285,6 +285,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
@@ -528,6 +529,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

@@ -361,6 +361,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