From 6471de61797eb0c1545668d6a15aae52bde7cddf Mon Sep 17 00:00:00 2001 From: Brent Yorgey Date: Thu, 27 Jun 2024 14:56:16 -0500 Subject: [PATCH] Change `meetAll` to return a list (#1999) Closes #1998. --- data/entities.yaml | 8 ++------ data/scenarios/Testing/920-meet.yaml | 18 +++++++++++++++--- data/scenarios/Tutorials/crash-secret.sw | 13 +++++++++---- src/swarm-engine/Swarm/Game/CESK.hs | 5 ----- src/swarm-engine/Swarm/Game/Step.hs | 9 --------- src/swarm-engine/Swarm/Game/Step/Const.hs | 14 ++++++-------- src/swarm-engine/Swarm/Game/Value.hs | 8 ++++++-- .../Swarm/Language/Syntax/Constants.hs | 2 +- src/swarm-lang/Swarm/Language/Typecheck.hs | 2 +- 9 files changed, 40 insertions(+), 39 deletions(-) diff --git a/data/entities.yaml b/data/entities.yaml index 2704d9f30..aa53ab8a5 100644 --- a/data/entities.yaml +++ b/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 diff --git a/data/scenarios/Testing/920-meet.yaml b/data/scenarios/Testing/920-meet.yaml index 09567cbd3..2a9e64d42 100644 --- a/data/scenarios/Testing/920-meet.yaml +++ b/data/scenarios/Testing/920-meet.yaml @@ -8,13 +8,25 @@ 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] @@ -22,7 +34,7 @@ robots: devices: - logger - antenna - - ADT calculator + - hyperloop - grabber inventory: - [7, boat] diff --git a/data/scenarios/Tutorials/crash-secret.sw b/data/scenarios/Tutorials/crash-secret.sw index b050bb5dc..578b532c2 100644 --- a/data/scenarios/Tutorials/crash-secret.sw +++ b/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; diff --git a/src/swarm-engine/Swarm/Game/CESK.hs b/src/swarm-engine/Swarm/Game/CESK.hs index 750d07217..ac47c50ef 100644 --- a/src/swarm-engine/Swarm/Game/CESK.hs +++ b/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) diff --git a/src/swarm-engine/Swarm/Game/Step.hs b/src/swarm-engine/Swarm/Game/Step.hs index e633e901b..aadb22d9c 100644 --- a/src/swarm-engine/Swarm/Game/Step.hs +++ b/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) diff --git a/src/swarm-engine/Swarm/Game/Step/Const.hs b/src/swarm-engine/Swarm/Game/Step/Const.hs index 0c72c300d..114d61035 100644 --- a/src/swarm-engine/Swarm/Game/Step/Const.hs +++ b/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 diff --git a/src/swarm-engine/Swarm/Game/Value.hs b/src/swarm-engine/Swarm/Game/Value.hs index 937a6289d..f53d59626 100644 --- a/src/swarm-engine/Swarm/Game/Value.hs +++ b/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) diff --git a/src/swarm-lang/Swarm/Language/Syntax/Constants.hs b/src/swarm-lang/Swarm/Language/Syntax/Constants.hs index 142d53b0b..c7d8866cf 100644 --- a/src/swarm-lang/Swarm/Language/Syntax/Constants.hs +++ b/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 -> diff --git a/src/swarm-lang/Swarm/Language/Typecheck.hs b/src/swarm-lang/Swarm/Language/Typecheck.hs index b168ed9f9..51e2ec461 100644 --- a/src/swarm-lang/Swarm/Language/Typecheck.hs +++ b/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 |]