mirror of
https://github.com/swarm-game/swarm.git
synced 2024-10-03 19:17:31 +03:00
parent
d9382ad21e
commit
6471de6179
@ -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
|
||||
|
@ -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]
|
||||
|
@ -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;
|
||||
|
@ -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)
|
||||
|
@ -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)
|
||||
|
@ -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
|
||||
|
@ -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)
|
||||
|
@ -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 ->
|
||||
|
@ -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 |]
|
||||
|
Loading…
Reference in New Issue
Block a user