Towards #1238

'act' command

data/entities.yaml

@@ -823,6 +823,18 @@
   capabilities: [power]
   properties: [portable]
 
+- name: agency card
+  display:
+    attr: device
+    char: 'A'
+  description:
+  - Become a card-carrying member of the Nice Roboticists Agency.
+  - Philosophically speaking, this "agency" grants a robot the capacity to `act`.
+  - |
+    `act : dir -> cmd unit` modifies an entity in said direction.
+  capabilities: [act]
+  properties: [portable]
+
 - name: drill
   display:
     attr: device

data/scenarios/Testing/00-ORDER.txt

@@ -33,4 +33,5 @@
 1207-scout-command.yaml
 1218-stride-command.yaml
 1234-push-command.yaml
+1238-act-command.yaml
 1256-halt-command.yaml

data/scenarios/Testing/1238-act-command.yaml

@@ -0,0 +1,86 @@
+version: 1
+name: Act command
+creative: false
+description: Open a gate
+objectives:
+  - goal:
+      - Grab the flower on the other side of the gate.
+    condition: |
+      as base {has "flower"}
+solution: |
+  move;
+  _k <- grab;
+  act forward;
+  move;
+  move;
+  grab;
+robots:
+  - name: base
+    dir: [1,0]
+    display:
+      char: Ω
+      attr: robot
+    devices:
+      - dictionary
+      - grabber
+      - toolkit
+      - logger
+      - treads
+      - calculator
+      - drill
+      - agency card
+      - welder
+entities:
+- name: fence
+  display:
+    attr: wood
+    char: '#'
+  description:
+  - Impassable barrier
+  properties: [known, unwalkable]
+- name: gate key
+  display:
+    attr: iron
+    char: 'k'
+  description:
+  - Can open a closed gate
+  capabilities: [drill]
+  properties: [known, portable]
+- name: closed gate
+  display:
+    attr: wood
+    char: '|'
+  description:
+  - Cannot pass through this
+  properties: [known, unwalkable]
+- name: open gate
+  display:
+    attr: wood
+    char: '/'
+  description:
+  - Can pass through this
+  properties: [known]
+recipes:
+  - in:
+      - [1, closed gate]
+    out:
+      - [1, open gate]
+    required:
+      - [1, drill]
+known: [flower]
+world:
+  default: [blank]
+  palette:
+    'Ω': [grass, null, base]
+    '.': [grass]
+    '#': [grass, fence]
+    '|': [grass, closed gate]
+    '*': [grass, flower]
+    'k': [grass, gate key]
+  upperleft: [0, 0]
+  map: |
+   ......
+   ..###.
+   Ωk|*#.
+   ..###.
+   ......

editors/emacs/swarm-mode.el

@@ -67,6 +67,7 @@
                "has"
                "equipped"
                "count"
+               "act"
                "drill"
                "build"
                "salvage"

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|build|salvage|reprogram|say|listen|log|view|appear|create|halt|time|scout|whereami|detect|resonate|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|push|stride|turn|grab|harvest|place|give|equip|unequip|make|has|equipped|count|act|drill|build|salvage|reprogram|say|listen|log|view|appear|create|halt|time|scout|whereami|detect|resonate|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"
 				}
 			]
 			},

example/list.sw

@@ -179,22 +179,22 @@ def index = \i.\xs.
     {index (i-1) (tail xs)}
 end
 
-def for : int -> int -> (int -> cmd a) -> cmd unit = \s.\e.\act.
+def for : int -> int -> (int -> cmd a) -> cmd unit = \s.\e.\f.
   if (s == e) {}
-  {act s; for (s+1) e act}
+  {f s; for (s+1) e f}
 end
 
 // for_each_i : int -> listI int -> (int * int -> cmd a) -> cmd unit
-def for_each_i = \i.\xs.\act.
+def for_each_i = \i.\xs.\f.
   if (xs == nil) {}
   { let ht = headTail xs
-    in act i (force $ fst ht); for_each_i (i+1) (force $ snd ht) act
+    in f i (force $ fst ht); for_each_i (i+1) (force $ snd ht) f
   }
 end
 
 // for_each : listI int -> (int -> cmd a) -> cmd unit
-def for_each = \xs.\act.
-  for_each_i 0 xs (\i. act)
+def for_each = \xs.\f.
+  for_each_i 0 xs (\i. f)
 end
 
 /*******************************************************************/

src/Swarm/Game/Step.hs

@@ -1461,65 +1461,12 @@ execConst c vs s k = do
     Time -> do
       t <- use ticks
       return $ Out (VInt t) s k
-    Drill -> case vs of
-      [VDir d] -> do
-        rname <- use robotName
-        inv <- use robotInventory
-        ins <- use equippedDevices
-
-        let equippedDrills = extantElemsWithCapability CDrill ins
-            -- Heuristic: choose the drill with the more elaborate name.
-            -- E.g. "metal drill" vs. "drill"
-            preferredDrill = listToMaybe $ sortOn (Down . T.length . (^. entityName)) equippedDrills
-
-        drill <- preferredDrill `isJustOr` Fatal "Drill is required but not equipped?!"
-
-        let directionText = case d of
-              DRelative DDown -> "under"
-              DRelative DForward -> "ahead of"
-              DRelative DBack -> "behind"
-              _ -> directionSyntax d <> " of"
-
-        (nextLoc, nextME) <- lookInDirection d
-        nextE <-
-          nextME
-            `isJustOrFail` ["There is nothing to drill", directionText, "robot", rname <> "."]
-
-        inRs <- use recipesIn
-
-        let recipes = filter drilling (recipesFor inRs nextE)
-            drilling = any ((== drill) . snd) . view recipeRequirements
-
-        not (null recipes) `holdsOrFail` ["There is no way to drill", indefinite (nextE ^. entityName) <> "."]
-
-        -- add the drilled entity so it can be consumed by the recipe
-        let makeRecipe r = (,r) <$> make' (insert nextE inv, ins) r
-        chosenRecipe <- weightedChoice (\((_, _), r) -> r ^. recipeWeight) (rights (map makeRecipe recipes))
-        ((invTaken, outs), recipe) <-
-          chosenRecipe
-            `isJustOrFail` ["You don't have the ingredients to drill", indefinite (nextE ^. entityName) <> "."]
-
-        let (out, down) = L.partition ((`hasProperty` Portable) . snd) outs
-        let learn = map (LearnEntity . snd) down
-        let gain = map (uncurry AddEntity) out
-
-        newEntity <- case down of
-          [] -> pure Nothing
-          [(1, de)] -> pure $ Just de
-          _ -> throwError $ Fatal "Bad recipe:\n more than one unmovable entity produced."
-        let changeWorld =
-              ReplaceEntity
-                { updatedLoc = nextLoc
-                , originalEntity = nextE
-                , newEntity = newEntity
-                }
-
-        -- take recipe inputs from inventory and add outputs after recipeTime
-        robotInventory .= invTaken
-
-        let cmdOutput = asValue $ snd <$> listToMaybe out
-        finishCookingRecipe recipe cmdOutput [changeWorld] (learn <> gain)
-      _ -> badConst
+    Act -> do
+      drillOut <- doDrill
+      return $ case drillOut of
+        Out _ s' k' -> Out VUnit s' k'
+        _ -> Out VUnit s k
+    Drill -> doDrill
     Blocked -> do
       loc <- use robotLocation
       orient <- use robotOrientation
@@ -2103,6 +2050,65 @@ execConst c vs s k = do
       let msg = "The operator '$' should only be a syntactic sugar and removed in elaboration:\n"
        in throwError . Fatal $ msg <> badConstMsg
  where
+  doDrill = case vs of
+    [VDir d] -> do
+      rname <- use robotName
+      inv <- use robotInventory
+      ins <- use equippedDevices
+
+      let equippedDrills = extantElemsWithCapability CDrill ins
+          -- Heuristic: choose the drill with the more elaborate name.
+          -- E.g. "metal drill" vs. "drill"
+          preferredDrill = listToMaybe $ sortOn (Down . T.length . (^. entityName)) equippedDrills
+
+      drill <- preferredDrill `isJustOr` Fatal "Drill is required but not equipped?!"
+
+      let directionText = case d of
+            DRelative DDown -> "under"
+            DRelative DForward -> "ahead of"
+            DRelative DBack -> "behind"
+            _ -> directionSyntax d <> " of"
+
+      (nextLoc, nextME) <- lookInDirection d
+      nextE <-
+        nextME
+          `isJustOrFail` ["There is nothing to drill", directionText, "robot", rname <> "."]
+
+      inRs <- use recipesIn
+
+      let recipes = filter drilling (recipesFor inRs nextE)
+          drilling = any ((== drill) . snd) . view recipeRequirements
+
+      not (null recipes) `holdsOrFail` ["There is no way to drill", indefinite (nextE ^. entityName) <> "."]
+
+      -- add the drilled entity so it can be consumed by the recipe
+      let makeRecipe r = (,r) <$> make' (insert nextE inv, ins) r
+      chosenRecipe <- weightedChoice (\((_, _), r) -> r ^. recipeWeight) (rights (map makeRecipe recipes))
+      ((invTaken, outs), recipe) <-
+        chosenRecipe
+          `isJustOrFail` ["You don't have the ingredients to drill", indefinite (nextE ^. entityName) <> "."]
+
+      let (out, down) = L.partition ((`hasProperty` Portable) . snd) outs
+      let learn = map (LearnEntity . snd) down
+      let gain = map (uncurry AddEntity) out
+
+      newEntity <- case down of
+        [] -> pure Nothing
+        [(1, de)] -> pure $ Just de
+        _ -> throwError $ Fatal "Bad recipe:\n more than one unmovable entity produced."
+      let changeWorld =
+            ReplaceEntity
+              { updatedLoc = nextLoc
+              , originalEntity = nextE
+              , newEntity = newEntity
+              }
+
+      -- take recipe inputs from inventory and add outputs after recipeTime
+      robotInventory .= invTaken
+
+      let cmdOutput = asValue $ snd <$> listToMaybe out
+      finishCookingRecipe recipe cmdOutput [changeWorld] (learn <> gain)
+    _ -> badConst
   goAtomic :: HasRobotStepState sig m => m CESK
   goAtomic = case vs of
     -- To execute an atomic block, set the runningAtomic flag,

src/Swarm/Language/Capability.hs

@@ -68,6 +68,8 @@ data Capability
     CBuild
   | -- | Execute the 'Salvage' command
     CSalvage
+  | -- | Execute the 'Act' command
+    CAct
   | -- | Execute the 'Drill' command
     CDrill
   | -- | Execute the 'Whereami' command
@@ -223,6 +225,7 @@ constCaps = \case
   Reprogram -> Just CReprogram
   Meet -> Just CMeet
   MeetAll -> Just CMeet
+  Act -> Just CAct
   Drill -> Just CDrill
   Neg -> Just CArith
   Add -> Just CArith

src/Swarm/Language/Syntax.hs

@@ -235,6 +235,8 @@ data Const
     Equipped
   | -- | Sense how many of a certain item we have.
     Count
+  | -- | Act upon an entity.
+    Act
   | -- | Drill through an entity.
     Drill
   | -- | Construct a new robot.
@@ -601,6 +603,11 @@ constInfo c = case c of
   Reprogram ->
     command 2 long . doc "Reprogram another robot with a new command." $
       ["The other robot has to be nearby and idle."]
+  Act ->
+    command 1 long . doc "Act upon an entity." $
+      [ "This command transforms an entity in the world using a device."
+      , "It will automatically `use` the appropriate device required by a recipe that takes the target entity as input."
+      ]
   Drill ->
     command 1 long . doc "Drill through an entity." $
       [ "Usually you want to `drill forward` when exploring to clear out obstacles."

src/Swarm/Language/Typecheck.hs

@@ -570,6 +570,7 @@ inferConst c = case c of
   Count -> [tyQ| text -> cmd int |]
   Reprogram -> [tyQ| actor -> {cmd a} -> cmd unit |]
   Build -> [tyQ| {cmd a} -> cmd actor |]
+  Act -> [tyQ| dir -> cmd unit |]
   Drill -> [tyQ| dir -> cmd (unit + text) |]
   Salvage -> [tyQ| cmd unit |]
   Say -> [tyQ| text -> cmd unit |]

test/integration/Main.hs

@@ -285,6 +285,7 @@ testScenarioSolution _ci _em =
         , testSolution Default "Testing/1207-scout-command"
         , testSolution Default "Testing/1218-stride-command"
         , testSolution Default "Testing/1234-push-command"
+        , testSolution Default "Testing/1238-act-command"
         , testSolution Default "Testing/1256-halt-command"
         ]
     ]