Change meetAll to return a list (#1999)

Closes #1998.

data/entities.yaml

@@ -1183,12 +1183,8 @@
       It returns a reference to the nearest actor, or a unit value if
       none are found.
     - |
-      `meetAll : (b -> Actor -> Cmd b) -> b -> Cmd b` runs a command on
-      every nearby actor (other than oneself), folding over the results
-      to compute a final result of type `b`{=type}.  For example, if
-      `x`{=snippet}, `y`{=snippet}, and `z`{=snippet}
-      are nearby actors, then `meetAll f b0`{=snippet} is equivalent to
-      `b1 <- f b0 x; b2 <- f b1 y; f b2 z`{=snippet}.
+      `meetAll : Cmd (rec l. Unit + Actor * l)` returns a list of
+      all the nearby actors other than oneself.
   properties: [pickable]
   capabilities: [meet]
 - name: GPS receiver

data/scenarios/Testing/920-meet.yaml

@@ -8,21 +8,33 @@ objectives:
       r0 <- robotNamed "other0";
       b0 <- as r0 { has "boat" };
       teleport self (0,0);
-      b1 <- meetAll (\b. \r. b0 <- as r {has "boat"}; return (b && b0)) true;
+      def all : (rec l. Unit + a * l) -> (a -> Cmd Bool) -> Cmd Bool =
+        \xs. \f. case xs
+          (\_. return true)
+          (\cons. b <- f (fst cons); if b {all (snd cons) f} {return false})
+      end;
+      rs <- meetAll;
+      b1 <- all rs (\r. as r {has "boat"});
       n2 <- as r0 { count "boat" };
       return (b0 && b1 && (n2 == 2))
 solution: |
   mr0 <- meet;
   case mr0 (\_. return ()) (\r0. give r0 "boat");
-  meetAll (\_. \r. give r "boat") ()
+  def forM_ : (rec l. Unit + a * l) -> (a -> Cmd b) -> Cmd Unit =
+    \xs. \f. case xs
+      (\_. return ())
+      (\cons. f (fst cons); forM_ (snd cons) f)
+  end;
+  rs <- meetAll;
+  forM_ rs (\r. give r "boat")
 robots:
   - name: base
     loc: [0, 0]
     dir: east
     devices:
       - logger
       - antenna
-      - ADT calculator
+      - hyperloop
       - grabber
     inventory:
       - [7, boat]

data/scenarios/Tutorials/crash-secret.sw

@@ -21,11 +21,17 @@ end;
 
 myLoc <- whereami;
 
+def foldM : (rec l. Unit + a * l) -> b -> (b -> a -> Cmd b) -> Cmd b =
+  \xs. \b. \f. case xs
+    (\_. return b)
+    (\cons. b' <- f b (fst cons); foldM (snd cons) b' f)
+end
+
 // Try to give a robot a Win, filtering out those that were already given a Win.
 // The robot will also receive instructions, so it **must have a logger!**
-def tryGive: Text -> (Actor -> Bool) -> Cmd (Actor -> Bool) = \msg.
-  // (b -> Actor -> Cmd b) -> b -> Cmd b
-  meetAll $ \f.\rob.
+def tryGive: Text -> (Actor -> Bool) -> Cmd (Actor -> Bool) = \msg. \ok.
+  rs <- meetAll;
+  foldM rs ok $ \f.\rob.
     if (not $ f rob) {
       log $ "skipping the robot " ++ format rob ++ "because it already has a Win";
       return f
@@ -45,7 +51,6 @@ def tryGive: Text -> (Actor -> Bool) -> Cmd (Actor -> Bool) = \msg.
           log $ "the robot " ++ format rob ++ "is missing a logger!";
           return f;
         };
-
       }
     }
 end;

src/swarm-engine/Swarm/Game/CESK.hs

@@ -152,10 +152,6 @@ data Frame
     FUpdate Addr
   | -- | Signal that we are done with an atomic computation.
     FFinishAtomic
-  | -- | We are in the middle of running a computation for all the
-    --   nearby robots.  We have the function to run, and the list of
-    --   robot IDs to run it on.
-    FMeetAll Value [Int]
   | -- | We are in the middle of evaluating a record: some fields have
     --   already been evaluated; we are focusing on evaluating one
     --   field; and some fields have yet to be evaluated.
@@ -424,7 +420,6 @@ prettyFrame f (p, inner) = case f of
   FImmediate c _worldUpds _robotUpds -> prettyPrefix ("I[" <> ppr c <> "]·") (p, inner)
   FUpdate {} -> (p, inner)
   FFinishAtomic -> prettyPrefix "A·" (p, inner)
-  FMeetAll _ _ -> prettyPrefix "M·" (p, inner)
   FRcd _ done foc rest -> (11, encloseSep "[" "]" ", " (pDone ++ [pFoc] ++ pRest))
    where
     pDone = map (\(x, v) -> pretty x <+> "=" <+> ppr (valueToTerm v)) (reverse done)

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

@@ -726,15 +726,6 @@ stepCESK cesk = case cesk of
     runningAtomic .= False
     return $ Out v s k
 
-  -- Machinery for implementing the 'Swarm.Language.Syntax.MeetAll' command.
-  -- First case: done meeting everyone.
-  Out b s (FMeetAll _ [] : k) -> return $ Out b s k
-  -- More still to meet: apply the function to the current value b and
-  -- then the next robot id.  This will result in a command which we
-  -- execute, discard any generated environment, and then pass the
-  -- result to continue meeting the rest of the robots.
-  Out b s (FMeetAll f (rid : rids) : k) ->
-    return $ Out b s (FApp f : FArg (TRobot rid) mempty : FExec : FMeetAll f rids : k)
   -- To execute a bind expression, evaluate and execute the first
   -- command, and remember the second for execution later.
   Out (VBind mx mty mreq c1 c2 e) s (FExec : k) -> return $ In c1 e s (FExec : FBind mx ((,) <$> mty <*> mreq) c2 e : k)

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

@@ -946,14 +946,12 @@ execConst runChildProg c vs s k = do
               $ robotsInArea loc 1
               $ g ^. robotInfo -- all robots within Manhattan distance 1
       return $ mkReturn neighbor
-    MeetAll -> case vs of
-      [f, b] -> do
-        loc <- use robotLocation
-        rid <- use robotID
-        g <- get @GameState
-        let neighborIDs = filter (/= rid) . map (^. robotID) $ robotsInArea loc 1 $ g ^. robotInfo
-        return $ Out b s (FMeetAll f neighborIDs : k)
-      _ -> badConst
+    MeetAll -> do
+      loc <- use robotLocation
+      rid <- use robotID
+      g <- get @GameState
+      let neighborIDs = filter ((/= rid) . (^. robotID)) . robotsInArea loc 1 $ g ^. robotInfo
+      return $ mkReturn neighborIDs
     Whoami -> case vs of
       [] -> do
         name <- use robotName

src/swarm-engine/Swarm/Game/Value.hs

@@ -9,7 +9,9 @@
 module Swarm.Game.Value where
 
 import Control.Lens (view)
+import Data.Either.Extra (maybeToEither)
 import Data.Int (Int32)
+import Data.List (uncons)
 import Data.Text (Text)
 import Linear (V2 (..))
 import Swarm.Game.Entity
@@ -72,12 +74,14 @@ instance Valuable Direction where
   asValue = VDir
 
 instance (Valuable a) => Valuable (Maybe a) where
-  asValue Nothing = VInj False VUnit
-  asValue (Just x) = VInj True $ asValue x
+  asValue = asValue . maybeToEither ()
 
 instance (Valuable a, Valuable b) => Valuable (Either a b) where
   asValue (Left x) = VInj False $ asValue x
   asValue (Right x) = VInj True $ asValue x
 
+instance Valuable a => Valuable [a] where
+  asValue = asValue . uncons
+
 instance Valuable AreaDimensions where
   asValue (AreaDimensions w h) = asValue (w, h)

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

@@ -762,7 +762,7 @@ constInfo c = case c of
   Parent -> function 0 $ shortDoc (Set.singleton $ Query APriori) "Get a reference to the robot's parent."
   Base -> function 0 $ shortDoc (Set.singleton $ Query APriori) "Get a reference to the base."
   Meet -> command 0 Intangible $ shortDoc (Set.singleton $ Query $ Sensing RobotSensing) "Get a reference to a nearby actor, if there is one."
-  MeetAll -> command 0 long $ shortDoc (Set.fromList [Mutation $ RobotChange BehaviorChange, Query $ Sensing RobotSensing]) "Run a command for each nearby actor."
+  MeetAll -> command 0 Intangible $ shortDoc (Set.singleton $ Query $ Sensing RobotSensing) "Return a list of all the nearby actors."
   Whoami -> command 0 Intangible $ shortDoc (Set.singleton $ Query $ Sensing RobotSensing) "Get the robot's display name."
   Setname -> command 1 short $ shortDoc (Set.singleton $ Mutation $ RobotChange BehaviorChange) "Set the robot's display name."
   Random ->

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

@@ -832,7 +832,7 @@ inferConst c = case c of
   Parent -> [tyQ| Actor |]
   Base -> [tyQ| Actor |]
   Meet -> [tyQ| Cmd (Unit + Actor) |]
-  MeetAll -> [tyQ| (b -> Actor -> Cmd b) -> b -> Cmd b |]
+  MeetAll -> [tyQ| Cmd (rec l. Unit + Actor * l) |]
   Whoami -> [tyQ| Cmd Text |]
   Setname -> [tyQ| Text -> Cmd Unit |]
   Random -> [tyQ| Int -> Cmd Int |]