From e8d387d7391b31e3dd89a94cefe8fd40a3b23d73 Mon Sep 17 00:00:00 2001 From: Ishan Bhanuka Date: Fri, 8 Oct 2021 00:37:08 +0530 Subject: [PATCH] Add entity for reprogramming (#179) Closes #22 --- data/entities.yaml | 14 +++++++ src/Swarm/Game/Step.hs | 66 ++++++++++++++++++++++++++++++++ src/Swarm/Language/Capability.hs | 4 ++ src/Swarm/Language/Elaborate.hs | 5 +++ src/Swarm/Language/Syntax.hs | 4 ++ src/Swarm/Language/Typecheck.hs | 1 + 6 files changed, 94 insertions(+) diff --git a/data/entities.yaml b/data/entities.yaml index 595835b8..6bcdaf2c 100644 --- a/data/entities.yaml +++ b/data/entities.yaml @@ -405,6 +405,20 @@ properties: [portable] capabilities: [scan, sensefront] +- name: flash memory + display: + attr: device + char: 'ยง' + description: + - "Using a flash memory device, a robot can reprogram other robots using the + 'reprogram' command." + - "Only robots that have completed executing their previous command + can be reprogrammed." + - "The robot must possess enough capabilities to run the new command + otherwise it will fail." + properties: [portable] + capabilities: [reprogram] + - name: mirror display: attr: device diff --git a/src/Swarm/Game/Step.hs b/src/Swarm/Game/Step.hs index 3b865ba2..4838e856 100644 --- a/src/Swarm/Game/Step.hs +++ b/src/Swarm/Game/Step.hs @@ -809,6 +809,72 @@ execConst c vs k = do Raise -> case vs of [VString s] -> return $ Up (User s) k _ -> badConst + Reprogram -> case vs of + [VString childRobotName, VDelay _ cmd e] -> do + em <- lift . lift $ use entityMap + mode <- lift . lift $ use gameMode + rctx@(_, capCtx) <- use robotCtx + renv <- use robotEnv + + -- check if robot exists + childRobot <- + robotNamed childRobotName + >>= (`isJustOr` cmdExn Reprogram ["There is no robot named", childRobotName, "."]) + + -- check that current robot is not trying to reprogram self + myName <- use robotName + (childRobotName /= myName) + `holdsOr` cmdExn + Reprogram + ["You cannot make a robot reprogram itself"] + + -- check if robot has completed executing it's current command + _ <- + finalValue (childRobot ^. machine) + `isJustOr` cmdExn + Reprogram + ["You cannot reprogram a robot that has not completed its current command"] + + -- check if childRobot is at the correct distance + -- a robot can program adjacent robots + -- creative mode ignores distance checks + loc <- use robotLocation + ( mode == Creative + || (childRobot ^. robotLocation) `manhattan` loc <= 1 + ) + `holdsOr` cmdExn + Reprogram + ["You can only program adjacent robot"] + + let -- Find out what capabilities are required by the program that will + -- be run on the other robot, and what devices would provide those + -- capabilities. + (caps, _capCtx) = requiredCaps capCtx cmd + capDevices = S.fromList . mapMaybe (`deviceForCap` em) . S.toList $ caps + + -- device is ok if it is installed on the childRobot + deviceOK d = (childRobot ^. installedDevices) `E.contains` d + + missingDevices = S.filter (not . deviceOK) capDevices + + -- check if robot has all devices to execute new command + (mode == Creative || S.null missingDevices) + `holdsOr` cmdExn + Reprogram + [ "the target robot does not have required devices:\n" + , commaList (map (^. entityName) (S.toList missingDevices)) + ] + + -- update other robot's CEK machine, environment and context + -- the childRobot inherits the parent robot's environment + -- and context which collectively mean all the variables + -- declared in the parent robot + lift . lift $ robotMap . at childRobotName . _Just . machine .= In cmd e [FExec] + lift . lift $ robotMap . at childRobotName . _Just . robotEnv .= renv + lift . lift $ robotMap . at childRobotName . _Just . robotCtx .= rctx + + return $ Out VUnit k + _ -> badConst Build -> case vs of [VString name, VDelay _ cmd e] -> do r <- get diff --git a/src/Swarm/Language/Capability.hs b/src/Swarm/Language/Capability.hs index 05e17e02..83c09442 100644 --- a/src/Swarm/Language/Capability.hs +++ b/src/Swarm/Language/Capability.hs @@ -87,6 +87,8 @@ data Capability CLambda | -- | Enable recursive definitions CRecursion + | -- | Execute the 'Reprogram' command + CReprogram | -- | Capability to introspect and see it's own name CWhoami deriving (Eq, Ord, Show, Read, Enum, Bounded, Generic, Hashable, Data) @@ -249,6 +251,8 @@ constCaps Upload = S.singleton CScan -- interpreter. However, I suspect things currently start to go -- haywire if you try to build a robot that builds other robots. constCaps Build = S.singleton CBuild +-- Reprogram reqiures a CReprogram capability. +constCaps Reprogram = S.singleton CReprogram -- Some additional straightforward ones, which however currently -- cannot be used in classic mode since there is no craftable item -- which conveys their capability. diff --git a/src/Swarm/Language/Elaborate.hs b/src/Swarm/Language/Elaborate.hs index 47f9c8e0..c12331d1 100644 --- a/src/Swarm/Language/Elaborate.hs +++ b/src/Swarm/Language/Elaborate.hs @@ -56,5 +56,10 @@ elaborate = -- doing the constructing. rewrite (TApp (TApp (TConst Build) nm) prog) = TApp (TApp (TConst Build) nm) (TDelay prog) + -- Delay evaluation of the program argument to a 'Reprogram' command, + -- so it will be evaluated by the reprogrammed robot instead of the one + -- doing the reprogramming. + rewrite (TApp (TApp (TConst Reprogram) nm) prog) = + TApp (TApp (TConst Reprogram) nm) (TDelay prog) -- Leave any other subterms alone. rewrite t = t diff --git a/src/Swarm/Language/Syntax.hs b/src/Swarm/Language/Syntax.hs index 4a32bdf5..72cb96d3 100644 --- a/src/Swarm/Language/Syntax.hs +++ b/src/Swarm/Language/Syntax.hs @@ -178,6 +178,9 @@ data Const Make | -- | Construct a new robot. Build + | -- | Reprogram a robot that has executed it's command + -- with a new command + Reprogram | -- | Emit a message. Say | -- | View a certain robot. @@ -335,6 +338,7 @@ constInfo c = case c of Give -> commandLow 2 Install -> commandLow 2 Make -> commandLow 1 + Reprogram -> commandLow 2 Build -> commandLow 2 Say -> commandLow 1 View -> commandLow 1 diff --git a/src/Swarm/Language/Typecheck.hs b/src/Swarm/Language/Typecheck.hs index 51b8c38a..4744507a 100644 --- a/src/Swarm/Language/Typecheck.hs +++ b/src/Swarm/Language/Typecheck.hs @@ -422,6 +422,7 @@ inferConst c = toU $ case c of Give -> [tyQ| string -> string -> cmd () |] Install -> [tyQ| string -> string -> cmd () |] Make -> [tyQ| string -> cmd () |] + Reprogram -> [tyQ| forall a. string -> cmd a -> cmd () |] Build -> [tyQ| forall a. string -> cmd a -> cmd string |] Say -> [tyQ| string -> cmd () |] View -> [tyQ| string -> cmd () |]