From 8e0066c56062717f1d073fc70380f0c4290f5205 Mon Sep 17 00:00:00 2001 From: Karl Ostmo Date: Sun, 28 May 2023 17:27:31 -0700 Subject: [PATCH] Towards #1238 'act' command --- data/entities.yaml | 12 ++ data/scenarios/Testing/00-ORDER.txt | 1 + data/scenarios/Testing/1238-act-command.yaml | 87 ++++++++++++ editors/emacs/swarm-mode.el | 1 + editors/vscode/syntaxes/swarm.tmLanguage.json | 2 +- example/list.sw | 12 +- src/Swarm/Game/Step.hs | 124 +++++++++--------- src/Swarm/Language/Capability.hs | 3 + src/Swarm/Language/Syntax.hs | 7 + src/Swarm/Language/Typecheck.hs | 1 + test/integration/Main.hs | 1 + 11 files changed, 185 insertions(+), 66 deletions(-) create mode 100644 data/scenarios/Testing/1238-act-command.yaml diff --git a/data/entities.yaml b/data/entities.yaml index a690742276..145e3f4935 100644 --- a/data/entities.yaml +++ b/data/entities.yaml @@ -823,6 +823,18 @@ capabilities: [power] properties: [portable] +- name: agency card + display: + attr: device + char: 'A' + description: + - Become a card-carrying member of the Nice Roboticists Agency. + - Philosophically speaking, this "agency" grants a robot the capacity to `act`. + - | + `act : dir -> cmd unit` modifies an entity in said direction. + capabilities: [act] + properties: [portable] + - name: drill display: attr: device diff --git a/data/scenarios/Testing/00-ORDER.txt b/data/scenarios/Testing/00-ORDER.txt index 0f83cab058..bcbd8c25ca 100644 --- a/data/scenarios/Testing/00-ORDER.txt +++ b/data/scenarios/Testing/00-ORDER.txt @@ -33,4 +33,5 @@ 1207-scout-command.yaml 1218-stride-command.yaml 1234-push-command.yaml +1238-act-command.yaml 1256-halt-command.yaml diff --git a/data/scenarios/Testing/1238-act-command.yaml b/data/scenarios/Testing/1238-act-command.yaml new file mode 100644 index 0000000000..c9c86c889c --- /dev/null +++ b/data/scenarios/Testing/1238-act-command.yaml @@ -0,0 +1,87 @@ +version: 1 +name: Act command +creative: false +description: Open a gate +objectives: + - goal: + - Grab the flower on the other side of the gate. + condition: | + as base {has "flower"} +solution: | + move; + _k <- grab; + act forward; + move; + move; + grab; +robots: + - name: base + dir: [1,0] + display: + char: Ω + attr: robot + devices: + - dictionary + - grabber + - toolkit + - logger + - treads + - calculator + - drill + - agency card + - welder +entities: +- name: fence + display: + attr: wood + char: '#' + description: + - Impassable barrier + properties: [known, unwalkable] +- name: gate key + display: + attr: iron + char: 'k' + description: + - Can open a closed gate + capabilities: [drill] + properties: [known, portable] +- name: closed gate + display: + attr: wood + char: '|' + description: + - Cannot pass through this + properties: [known, unwalkable] +- name: open gate + display: + attr: wood + char: '/' + description: + - Can pass through this + properties: [known] +recipes: + - in: + - [1, closed gate] + out: + - [1, open gate] + required: + - [1, drill] +known: [flower] +world: + default: [blank] + palette: + 'Ω': [grass, null, base] + '.': [grass] + '#': [grass, fence] + '|': [grass, closed gate] + '*': [grass, flower] + 'k': [grass, gate key] + upperleft: [0, 0] + map: | + ...... + ..###. + ..###. + Ωk|*#. + ..###. + ...... diff --git a/editors/emacs/swarm-mode.el b/editors/emacs/swarm-mode.el index 90430eb7a2..03681217f5 100644 --- a/editors/emacs/swarm-mode.el +++ b/editors/emacs/swarm-mode.el @@ -67,6 +67,7 @@ "has" "equipped" "count" + "act" "drill" "build" "salvage" diff --git a/editors/vscode/syntaxes/swarm.tmLanguage.json b/editors/vscode/syntaxes/swarm.tmLanguage.json index 9595b3f64f..335ca07185 100644 --- a/editors/vscode/syntaxes/swarm.tmLanguage.json +++ b/editors/vscode/syntaxes/swarm.tmLanguage.json @@ -58,7 +58,7 @@ }, { "name": "keyword.other", - "match": "\\b(?i)(self|parent|base|if|inl|inr|case|fst|snd|force|undefined|fail|not|format|chars|split|charat|tochar|key|noop|wait|selfdestruct|move|push|stride|turn|grab|harvest|place|give|equip|unequip|make|has|equipped|count|drill|build|salvage|reprogram|say|listen|log|view|appear|create|halt|time|scout|whereami|detect|resonate|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" + "match": "\\b(?i)(self|parent|base|if|inl|inr|case|fst|snd|force|undefined|fail|not|format|chars|split|charat|tochar|key|noop|wait|selfdestruct|move|push|stride|turn|grab|harvest|place|give|equip|unequip|make|has|equipped|count|act|drill|build|salvage|reprogram|say|listen|log|view|appear|create|halt|time|scout|whereami|detect|resonate|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" } ] }, diff --git a/example/list.sw b/example/list.sw index 69221c1c40..1b07fcb3f1 100644 --- a/example/list.sw +++ b/example/list.sw @@ -179,22 +179,22 @@ def index = \i.\xs. {index (i-1) (tail xs)} end -def for : int -> int -> (int -> cmd a) -> cmd unit = \s.\e.\act. +def for : int -> int -> (int -> cmd a) -> cmd unit = \s.\e.\f. if (s == e) {} - {act s; for (s+1) e act} + {f s; for (s+1) e f} end // for_each_i : int -> listI int -> (int * int -> cmd a) -> cmd unit -def for_each_i = \i.\xs.\act. +def for_each_i = \i.\xs.\f. if (xs == nil) {} { let ht = headTail xs - in act i (force $ fst ht); for_each_i (i+1) (force $ snd ht) act + in f i (force $ fst ht); for_each_i (i+1) (force $ snd ht) f } end // for_each : listI int -> (int -> cmd a) -> cmd unit -def for_each = \xs.\act. - for_each_i 0 xs (\i. act) +def for_each = \xs.\f. + for_each_i 0 xs (\i. f) end /*******************************************************************/ diff --git a/src/Swarm/Game/Step.hs b/src/Swarm/Game/Step.hs index f577dea817..dee2291892 100644 --- a/src/Swarm/Game/Step.hs +++ b/src/Swarm/Game/Step.hs @@ -1461,65 +1461,12 @@ execConst c vs s k = do Time -> do t <- use ticks return $ Out (VInt t) s k - Drill -> case vs of - [VDir d] -> do - rname <- use robotName - inv <- use robotInventory - ins <- use equippedDevices - - let equippedDrills = extantElemsWithCapability CDrill ins - -- Heuristic: choose the drill with the more elaborate name. - -- E.g. "metal drill" vs. "drill" - preferredDrill = listToMaybe $ sortOn (Down . T.length . (^. entityName)) equippedDrills - - drill <- preferredDrill `isJustOr` Fatal "Drill is required but not equipped?!" - - let directionText = case d of - DRelative DDown -> "under" - DRelative DForward -> "ahead of" - DRelative DBack -> "behind" - _ -> directionSyntax d <> " of" - - (nextLoc, nextME) <- lookInDirection d - nextE <- - nextME - `isJustOrFail` ["There is nothing to drill", directionText, "robot", rname <> "."] - - inRs <- use recipesIn - - let recipes = filter drilling (recipesFor inRs nextE) - drilling = any ((== drill) . snd) . view recipeRequirements - - not (null recipes) `holdsOrFail` ["There is no way to drill", indefinite (nextE ^. entityName) <> "."] - - -- add the drilled entity so it can be consumed by the recipe - let makeRecipe r = (,r) <$> make' (insert nextE inv, ins) r - chosenRecipe <- weightedChoice (\((_, _), r) -> r ^. recipeWeight) (rights (map makeRecipe recipes)) - ((invTaken, outs), recipe) <- - chosenRecipe - `isJustOrFail` ["You don't have the ingredients to drill", indefinite (nextE ^. entityName) <> "."] - - let (out, down) = L.partition ((`hasProperty` Portable) . snd) outs - let learn = map (LearnEntity . snd) down - let gain = map (uncurry AddEntity) out - - newEntity <- case down of - [] -> pure Nothing - [(1, de)] -> pure $ Just de - _ -> throwError $ Fatal "Bad recipe:\n more than one unmovable entity produced." - let changeWorld = - ReplaceEntity - { updatedLoc = nextLoc - , originalEntity = nextE - , newEntity = newEntity - } - - -- take recipe inputs from inventory and add outputs after recipeTime - robotInventory .= invTaken - - let cmdOutput = asValue $ snd <$> listToMaybe out - finishCookingRecipe recipe cmdOutput [changeWorld] (learn <> gain) - _ -> badConst + Act -> do + drillOut <- doDrill + return $ case drillOut of + Out _ s' k' -> Out VUnit s' k' + _ -> Out VUnit s k + Drill -> doDrill Blocked -> do loc <- use robotLocation orient <- use robotOrientation @@ -2103,6 +2050,65 @@ execConst 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 + doDrill = case vs of + [VDir d] -> do + rname <- use robotName + inv <- use robotInventory + ins <- use equippedDevices + + let equippedDrills = extantElemsWithCapability CDrill ins + -- Heuristic: choose the drill with the more elaborate name. + -- E.g. "metal drill" vs. "drill" + preferredDrill = listToMaybe $ sortOn (Down . T.length . (^. entityName)) equippedDrills + + drill <- preferredDrill `isJustOr` Fatal "Drill is required but not equipped?!" + + let directionText = case d of + DRelative DDown -> "under" + DRelative DForward -> "ahead of" + DRelative DBack -> "behind" + _ -> directionSyntax d <> " of" + + (nextLoc, nextME) <- lookInDirection d + nextE <- + nextME + `isJustOrFail` ["There is nothing to drill", directionText, "robot", rname <> "."] + + inRs <- use recipesIn + + let recipes = filter drilling (recipesFor inRs nextE) + drilling = any ((== drill) . snd) . view recipeRequirements + + not (null recipes) `holdsOrFail` ["There is no way to drill", indefinite (nextE ^. entityName) <> "."] + + -- add the drilled entity so it can be consumed by the recipe + let makeRecipe r = (,r) <$> make' (insert nextE inv, ins) r + chosenRecipe <- weightedChoice (\((_, _), r) -> r ^. recipeWeight) (rights (map makeRecipe recipes)) + ((invTaken, outs), recipe) <- + chosenRecipe + `isJustOrFail` ["You don't have the ingredients to drill", indefinite (nextE ^. entityName) <> "."] + + let (out, down) = L.partition ((`hasProperty` Portable) . snd) outs + let learn = map (LearnEntity . snd) down + let gain = map (uncurry AddEntity) out + + newEntity <- case down of + [] -> pure Nothing + [(1, de)] -> pure $ Just de + _ -> throwError $ Fatal "Bad recipe:\n more than one unmovable entity produced." + let changeWorld = + ReplaceEntity + { updatedLoc = nextLoc + , originalEntity = nextE + , newEntity = newEntity + } + + -- take recipe inputs from inventory and add outputs after recipeTime + robotInventory .= invTaken + + let cmdOutput = asValue $ snd <$> listToMaybe out + finishCookingRecipe recipe cmdOutput [changeWorld] (learn <> gain) + _ -> badConst goAtomic :: HasRobotStepState sig m => m CESK goAtomic = case vs of -- To execute an atomic block, set the runningAtomic flag, diff --git a/src/Swarm/Language/Capability.hs b/src/Swarm/Language/Capability.hs index bc3e51bbe0..d827dce3e1 100644 --- a/src/Swarm/Language/Capability.hs +++ b/src/Swarm/Language/Capability.hs @@ -68,6 +68,8 @@ data Capability CBuild | -- | Execute the 'Salvage' command CSalvage + | -- | Execute the 'Act' command + CAct | -- | Execute the 'Drill' command CDrill | -- | Execute the 'Whereami' command @@ -223,6 +225,7 @@ constCaps = \case Reprogram -> Just CReprogram Meet -> Just CMeet MeetAll -> Just CMeet + Act -> Just CAct Drill -> Just CDrill Neg -> Just CArith Add -> Just CArith diff --git a/src/Swarm/Language/Syntax.hs b/src/Swarm/Language/Syntax.hs index 5bb18dfdde..80f33f09ed 100644 --- a/src/Swarm/Language/Syntax.hs +++ b/src/Swarm/Language/Syntax.hs @@ -235,6 +235,8 @@ data Const Equipped | -- | Sense how many of a certain item we have. Count + | -- | Act upon an entity. + Act | -- | Drill through an entity. Drill | -- | Construct a new robot. @@ -601,6 +603,11 @@ constInfo c = case c of Reprogram -> command 2 long . doc "Reprogram another robot with a new command." $ ["The other robot has to be nearby and idle."] + Act -> + command 1 long . doc "Act upon an entity." $ + [ "This command transforms an entity in the world using a device." + , "It will automatically `use` the appropriate device required by a recipe that takes the target entity as input." + ] Drill -> command 1 long . doc "Drill through an entity." $ [ "Usually you want to `drill forward` when exploring to clear out obstacles." diff --git a/src/Swarm/Language/Typecheck.hs b/src/Swarm/Language/Typecheck.hs index 32366f2087..418a22cad5 100644 --- a/src/Swarm/Language/Typecheck.hs +++ b/src/Swarm/Language/Typecheck.hs @@ -570,6 +570,7 @@ inferConst c = case c of Count -> [tyQ| text -> cmd int |] Reprogram -> [tyQ| actor -> {cmd a} -> cmd unit |] Build -> [tyQ| {cmd a} -> cmd actor |] + Act -> [tyQ| dir -> cmd unit |] Drill -> [tyQ| dir -> cmd (unit + text) |] Salvage -> [tyQ| cmd unit |] Say -> [tyQ| text -> cmd unit |] diff --git a/test/integration/Main.hs b/test/integration/Main.hs index 606b74da57..ee49cc8115 100644 --- a/test/integration/Main.hs +++ b/test/integration/Main.hs @@ -285,6 +285,7 @@ testScenarioSolution _ci _em = , testSolution Default "Testing/1207-scout-command" , testSolution Default "Testing/1218-stride-command" , testSolution Default "Testing/1234-push-command" + , testSolution Default "Testing/1238-act-command" , testSolution Default "Testing/1256-halt-command" ] ]