subworld-aware teleportation and location query commands (#2195)

```
scripts/play.sh --scenario scenarios/Testing/144-subworlds/teleport-and-query.yaml --autoplay
```

data/scenarios/Testing/144-subworlds/00-ORDER.txt

@@ -3,3 +3,4 @@ subworld-shared-structures.yaml
 subworld-mapped-robots.yaml
 subworld-located-robots.yaml
 spatial-consistency-enforcement.yaml
+teleport-and-query.yaml

data/scenarios/Testing/144-subworlds/teleport-and-query.yaml

@@ -0,0 +1,66 @@
+version: 1
+name: Subworld teleportation
+description: |
+  Surface and underground with portals.
+objectives:
+  - goal:
+      - |
+        System robot must teleport the base to another subworld.
+        The goal condition utilizes location query command.
+    condition: |
+      as base {
+        myloc <- locateme;
+        return $ fst myloc == "underground";
+      }
+solution: |
+  noop
+robots:
+  - name: base
+    dir: east
+    devices:
+      - ADT calculator
+      - branch predictor
+      - comparator
+      - compass
+      - dictionary
+      - GPS receiver
+      - grabber
+      - lambda
+      - lodestone
+      - logger
+      - strange loop
+      - treads
+  - name: judge
+    dir: east
+    system: true
+    display:
+      char: 'J'
+      invisible: true
+    program: |
+      wait 10;
+      warp base ("underground", (0, 0));
+known: [flower, boulder]
+subworlds:
+  - name: underground
+    default: [blank]
+    palette:
+      '.': [dirt]
+      'f': [dirt, flower]
+      'b': [dirt, boulder]
+    upperleft: [-1, 1]
+    map: |
+      b..b..b..b
+      ....f.....
+      b..b..b..b
+world:
+  name: root
+  default: [blank]
+  palette:
+    '.': [grass]
+    'B': [grass, null, base]
+    't': [ice, null, judge]
+  upperleft: [-1, 1]
+  map: |
+    ..........
+    ...Bt.....
+    ..........

editors/emacs/swarm-mode.el

@@ -91,6 +91,7 @@
       "time"
       "scout"
       "whereami"
+      "locateme"
       "waypoint"
       "structure"
       "floorplan"
@@ -122,6 +123,7 @@
       "instant"
       "installkeyhandler"
       "teleport"
+      "warp"
       "as"
       "robotnamed"
       "robotnumbered"

editors/vim/swarm.vim

@@ -1,6 +1,6 @@
 syn keyword Keyword def tydef rec end let in require
 syn keyword Builtins self parent base if inl inr case fst snd force undefined fail not format chars split charat tochar key
-syn keyword Command noop wait selfdestruct move backup volume path push stride turn grab harvest sow ignite place ping give equip unequip make has equipped count drill use build salvage reprogram say listen log view appear create halt time scout whereami waypoint structure floorplan hastag tagmembers detect resonate density sniff chirp watch surveil heading blocked scan upload ishere isempty meet meetall whoami setname random run return try swap atomic instant installkeyhandler teleport as robotnamed robotnumbered knows
+syn keyword Command noop wait selfdestruct move backup volume path push stride turn grab harvest sow ignite place ping give equip unequip make has equipped count drill use build salvage reprogram say listen log view appear create halt time scout whereami locateme waypoint structure floorplan hastag tagmembers detect resonate density sniff chirp watch surveil heading blocked scan upload ishere isempty meet meetall whoami setname random run return try swap atomic instant installkeyhandler teleport warp as robotnamed robotnumbered knows
 syn keyword Direction east north west south down forward left back right
 syn match Type "\<[A-Z][a-zA-Z_]*\>"
 syn match Operators "[-=!<>|&+*/^$:]"

editors/vscode/syntaxes/swarm.tmLanguage.yaml

@@ -46,7 +46,7 @@ repository:
       keyword:
         name: keyword.other
         match: >-
-          \b(self|parent|base|if|inl|inr|case|fst|snd|force|undefined|fail|not|format|chars|split|charat|tochar|key|noop|wait|selfdestruct|move|backup|volume|path|push|stride|turn|grab|harvest|sow|ignite|place|ping|give|equip|unequip|make|has|equipped|count|drill|use|build|salvage|reprogram|say|listen|log|view|appear|create|halt|time|scout|whereami|waypoint|structure|floorplan|hastag|tagmembers|detect|resonate|density|sniff|chirp|watch|surveil|heading|blocked|scan|upload|ishere|isempty|meet|meetall|whoami|setname|random|run|return|try|swap|atomic|instant|installkeyhandler|teleport|as|robotnamed|robotnumbered|knows)\b
+          \b(self|parent|base|if|inl|inr|case|fst|snd|force|undefined|fail|not|format|chars|split|charat|tochar|key|noop|wait|selfdestruct|move|backup|volume|path|push|stride|turn|grab|harvest|sow|ignite|place|ping|give|equip|unequip|make|has|equipped|count|drill|use|build|salvage|reprogram|say|listen|log|view|appear|create|halt|time|scout|whereami|locateme|waypoint|structure|floorplan|hastag|tagmembers|detect|resonate|density|sniff|chirp|watch|surveil|heading|blocked|scan|upload|ishere|isempty|meet|meetall|whoami|setname|random|run|return|try|swap|atomic|instant|installkeyhandler|teleport|warp|as|robotnamed|robotnumbered|knows)\b
       require:
         name: keyword.control.require
         match: \b(require)\b

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

@@ -272,34 +272,12 @@ execConst runChildProg c vs s k = do
       _ -> badConst
     Teleport -> case vs of
       [VRobot rid, VPair (VInt x) (VInt y)] -> do
-        -- Make sure the other robot exists and is close
-        target <- getRobotWithinTouch rid
-        -- either change current robot or one in robot map
-        let oldLoc = target ^. robotLocation
-            nextLoc = fmap (const $ Location (fromIntegral x) (fromIntegral y)) oldLoc
-
-        onTarget rid $ do
-          checkMoveAhead nextLoc $ \case
-            PathBlockedBy _ -> Destroy
-            PathLiquid _ -> Destroy
-          updateRobotLocation oldLoc nextLoc
-
-        -- Privileged robots can teleport without causing any
-        -- improbable effects.  Unprivileged robots must be using an
-        -- infinite improbability drive, which can cause a random entity
-        -- to spawn near the target location.
-        omni <- isPrivilegedBot
-        unless omni $ do
-          let area = map (<$ nextLoc) $ getLocsInArea (nextLoc ^. planar) 5
-          emptyLocs <- filterM (fmap isNothing . entityAt) area
-          randomLoc <- weightedChoice (const 1) emptyLocs
-          es <- uses (landscape . terrainAndEntities . entityMap) allEntities
-          randomEntity <- weightedChoice (const 1) es
-          case (randomLoc, randomEntity) of
-            (Just loc, Just e) -> updateEntityAt loc (const (Just e))
-            _ -> return ()
-
-        return $ mkReturn ()
+        doTeleport rid (Location (fromIntegral x) (fromIntegral y) <$)
+      _ -> badConst
+    Warp -> case vs of
+      [VRobot rid, VPair (VText swName) (VPair (VInt x) (VInt y))] -> do
+        doTeleport rid . const . Cosmic (SubworldName swName) $
+          Location (fromIntegral x) (fromIntegral y)
       _ -> badConst
     Grab -> mkReturn <$> doGrab Grab' PerformRemoval
     Harvest -> mkReturn <$> doGrab Harvest' PerformRemoval
@@ -557,6 +535,9 @@ execConst runChildProg c vs s k = do
     Whereami -> do
       loc <- use robotLocation
       return $ mkReturn $ loc ^. planar
+    LocateMe -> do
+      loc <- use robotLocation
+      return $ mkReturn (loc ^. subworld, loc ^. planar)
     Waypoint -> case vs of
       [VText name, VInt idx] -> do
         lm <- use $ landscape . worldNavigation
@@ -1255,6 +1236,36 @@ execConst runChildProg c vs s k = do
       let msg = "The operator '$' should only be a syntactic sugar and removed in elaboration:\n"
        in throwError . Fatal $ msg <> badConstMsg
  where
+  doTeleport rid locUpdateFunc = do
+    -- Make sure the other robot exists and is close
+    target <- getRobotWithinTouch rid
+    -- either change current robot or one in robot map
+    let oldLoc = target ^. robotLocation
+        nextLoc = locUpdateFunc oldLoc
+
+    onTarget rid $ do
+      checkMoveAhead nextLoc $ \case
+        PathBlockedBy _ -> Destroy
+        PathLiquid _ -> Destroy
+      updateRobotLocation oldLoc nextLoc
+
+    -- Privileged robots can teleport without causing any
+    -- improbable effects.  Unprivileged robots must be using an
+    -- infinite improbability drive, which can cause a random entity
+    -- to spawn near the target location.
+    omni <- isPrivilegedBot
+    unless omni $ do
+      let area = map (<$ nextLoc) $ getLocsInArea (nextLoc ^. planar) 5
+      emptyLocs <- filterM (fmap isNothing . entityAt) area
+      randomLoc <- weightedChoice (const 1) emptyLocs
+      es <- uses (landscape . terrainAndEntities . entityMap) allEntities
+      randomEntity <- weightedChoice (const 1) es
+      case (randomLoc, randomEntity) of
+        (Just loc, Just e) -> updateEntityAt loc (const (Just e))
+        _ -> return ()
+
+    return $ mkReturn ()
+
   doDrill d = do
     ins <- use equippedDevices
 

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

@@ -18,6 +18,7 @@ import Swarm.Game.Entity
 import Swarm.Game.Location
 import Swarm.Game.Robot
 import Swarm.Game.Scenario.Topography.Area (AreaDimensions (..))
+import Swarm.Game.Universe
 import Swarm.Language.Syntax.Direction
 import Swarm.Language.Value
 
@@ -52,6 +53,9 @@ instance Valuable Bool where
 instance Valuable Text where
   asValue = VText
 
+instance Valuable SubworldName where
+  asValue = asValue . renderWorldName
+
 instance Valuable () where
   asValue = const VUnit
 

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

@@ -146,6 +146,8 @@ data Const
     Scout
   | -- | Get the current x, y coordinates
     Whereami
+  | -- | Get the current subworld and x, y coordinates
+    LocateMe
   | -- | Get the x, y coordinates of a named waypoint, by index
     Waypoint
   | -- | Get the x, y coordinates of southwest corner of a constructed structure, by index
@@ -304,6 +306,8 @@ data Const
 
     -- | Teleport a robot to the given position.
     Teleport
+  | -- | Relocate a robot to the given cosmic position.
+    Warp
   | -- | Run a command as if you were another robot.
     As
   | -- | Find an actor by name.
@@ -678,6 +682,11 @@ constInfo c = case c of
       shortDoc
         (Set.singleton $ Query $ Sensing RobotSensing)
         "Get the current x and y coordinates."
+  LocateMe ->
+    command 0 Intangible $
+      shortDoc
+        (Set.singleton $ Query $ Sensing RobotSensing)
+        "Get the current subworld and x, y coordinates."
   Waypoint ->
     command 2 Intangible . doc (Set.singleton $ Query APriori) "Get the x, y coordinates of a named waypoint, by index" $
       [ "Return only the waypoints in the same subworld as the calling robot."
@@ -852,6 +861,7 @@ constInfo c = case c of
       , "The second argument is a function to handle keyboard inputs."
       ]
   Teleport -> command 2 short $ shortDoc (Set.singleton $ Mutation $ RobotChange PositionChange) "Teleport a robot to the given location."
+  Warp -> command 2 short $ shortDoc (Set.singleton $ Mutation $ RobotChange PositionChange) "Relocate a robot to the given cosmic location."
   As -> command 2 Intangible $ shortDoc (Set.singleton $ Mutation $ RobotChange BehaviorChange) "Hypothetically run a command as if you were another robot."
   RobotNamed -> command 1 Intangible $ shortDoc (Set.singleton $ Query $ Sensing RobotSensing) "Find an actor by name."
   RobotNumbered -> command 1 Intangible $ shortDoc (Set.singleton $ Query $ Sensing RobotSensing) "Find an actor by number."

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

@@ -1036,6 +1036,7 @@ inferConst c = run . runReader @TVCtx Ctx.empty . quantify $ case c of
   Time -> [tyQ| Cmd Int |]
   Scout -> [tyQ| Dir -> Cmd Bool |]
   Whereami -> [tyQ| Cmd (Int * Int) |]
+  LocateMe -> [tyQ| Cmd (Text * (Int * Int)) |]
   Waypoint -> [tyQ| Text -> Int -> Cmd (Int * (Int * Int)) |]
   Structure -> [tyQ| Text -> Int -> Cmd (Unit + (Int * (Int * Int))) |]
   Floorplan -> [tyQ| Text -> Cmd (Int * Int) |]
@@ -1102,6 +1103,7 @@ inferConst c = run . runReader @TVCtx Ctx.empty . quantify $ case c of
   Key -> [tyQ| Text -> Key |]
   InstallKeyHandler -> [tyQ| Text -> (Key -> Cmd Unit) -> Cmd Unit |]
   Teleport -> [tyQ| Actor -> (Int * Int) -> Cmd Unit |]
+  Warp -> [tyQ| Actor -> (Text * (Int * Int)) -> Cmd Unit |]
   As -> [tyQ| Actor -> {Cmd a} -> Cmd a |]
   RobotNamed -> [tyQ| Text -> Cmd Actor |]
   RobotNumbered -> [tyQ| Int -> Cmd Actor |]

test/integration/Main.hs

@@ -358,6 +358,7 @@ testScenarioSolutions rs ui key =
         , testSolution Default "Testing/1295-density-command"
         , testSolution Default "Testing/1356-portals/portals-flip-and-rotate"
         , testSolution Default "Testing/144-subworlds/basic-subworld"
+        , testSolution Default "Testing/144-subworlds/teleport-and-query"
         , testSolution Default "Testing/144-subworlds/subworld-mapped-robots"
         , testSolution Default "Testing/144-subworlds/subworld-located-robots"
         , testSolution Default "Testing/144-subworlds/subworld-shared-structures"