Add entity for reprogramming (#179)

Closes #22

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

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

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.

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

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

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 () |]