packages feed

swarm 0.6.0.0 → 0.7.0.0

raw patch · 550 files changed

+21172/−10697 lines, 550 filesdep +brick-tabular-listdep +generic-datadep +monad-loggerdep −simple-enumerationdep ~MissingHdep ~SHAdep ~aesonbinary-addedPVP ok

version bump matches the API change (PVP)

Dependencies added: brick-tabular-list, generic-data, monad-logger, monoidmap, monoidmap-aeson, ordered-containers, quickcheck-instances, servant, servant-JuicyPixels

Dependencies removed: simple-enumeration

Dependency ranges changed: MissingH, SHA, aeson, array, base, boolexpr, brick, bytestring, colour, commonmark, containers, cookie, data-fix, exceptions, extra, filepath, fused-effects, githash, hashable, http-client, http-client-tls, http-types, lens, lsp, megaparsec, mtl, nonempty-containers, palette, pandoc, parser-combinators, prettyprinter, random, scientific, servant-docs, servant-multipart, servant-server, split, sqlite-simple, tasty, tasty-bench, tasty-hunit, tasty-quickcheck, template-haskell, text, text-rope, time, transformers, unordered-containers, utf8-string, vector, vty, wai-extra, warp, witch, witherable, yaml

API changes (from Hackage documentation)

- Swarm.Web: defaultPort :: Port
- Swarm.Web: instance Servant.Docs.Internal.ToCapture (Servant.API.Capture.Capture "id" Swarm.Web.RobotID)
- Swarm.Web: instance Servant.Docs.Internal.ToCapture (Servant.API.Capture.Capture "size" Swarm.Game.Scenario.Topography.Area.AreaDimensions)
- Swarm.Web: instance Servant.Docs.Internal.ToSample Data.Text.Internal.Text
- Swarm.Web: instance Servant.Docs.Internal.ToSample Swarm.Game.Scenario.Topography.Area.AreaDimensions
- Swarm.Web: instance Servant.Docs.Internal.ToSample Swarm.Web.RobotID
- Swarm.Web: instance Web.Internal.HttpApiData.FromHttpApiData Swarm.Game.Scenario.Topography.Area.AreaDimensions
- Swarm.Web: instance Web.Internal.HttpApiData.FromHttpApiData Swarm.Web.RobotID
- Swarm.Web: startWebThread :: Maybe Port -> ReadableIORef AppState -> BChan AppEvent -> IO (Either String Port)
- Swarm.Web: swarmApiHtml :: ByteString
- Swarm.Web: swarmApiMarkdown :: String
- Swarm.Web: type SwarmAPI = "robots" :> Get '[JSON] [Robot] :<|> "robot" :> Capture "id" RobotID :> Get '[JSON] (Maybe Robot) :<|> "goals" :> "prereqs" :> Get '[JSON] [PrereqSatisfaction] :<|> "goals" :> "active" :> Get '[JSON] [Objective] :<|> "goals" :> "graph" :> Get '[JSON] (Maybe GraphInfo) :<|> "goals" :> "uigoal" :> Get '[JSON] GoalTracking :<|> "goals" :> Get '[JSON] WinCondition :<|> "recognize" :> "log" :> Get '[JSON] [SearchLog EntityName] :<|> "recognize" :> "found" :> Get '[JSON] [StructureLocation] :<|> "code" :> "render" :> ReqBody '[PlainText] Text :> Post '[PlainText] Text :<|> "code" :> "run" :> ReqBody '[PlainText] Text :> Post '[PlainText] Text :<|> "paths" :> "log" :> Get '[JSON] (RingBuffer CacheLogEntry) :<|> "commands" :> Get '[JSON] CommandCatalog :<|> "repl" :> "history" :> "full" :> Get '[JSON] [REPLHistItem] :<|> "map" :> Capture "size" AreaDimensions :> Get '[JSON] GridResponse
- Swarm.Web: webMain :: Maybe (MVar WebStartResult) -> Port -> ReadableIORef AppState -> BChan AppEvent -> IO ()
- Swarm.Web.Worldview: CellGrid :: Grid Key -> [HexColor] -> CellGrid
- Swarm.Web.Worldview: GridResponse :: Bool -> Maybe CellGrid -> GridResponse
- Swarm.Web.Worldview: [colors] :: CellGrid -> [HexColor]
- Swarm.Web.Worldview: [coords] :: CellGrid -> Grid Key
- Swarm.Web.Worldview: [grid] :: GridResponse -> Maybe CellGrid
- Swarm.Web.Worldview: [isPlaying] :: GridResponse -> Bool
- Swarm.Web.Worldview: data CellGrid
- Swarm.Web.Worldview: data GridResponse
- Swarm.Web.Worldview: getCellGrid :: Scenario -> GameState -> AreaDimensions -> CellGrid
- Swarm.Web.Worldview: instance Data.Aeson.Types.ToJSON.ToJSON Swarm.Web.Worldview.CellGrid
- Swarm.Web.Worldview: instance Data.Aeson.Types.ToJSON.ToJSON Swarm.Web.Worldview.GridResponse
- Swarm.Web.Worldview: instance GHC.Generics.Generic Swarm.Web.Worldview.CellGrid
- Swarm.Web.Worldview: instance GHC.Generics.Generic Swarm.Web.Worldview.GridResponse
- Swarm.Web.Worldview: instance Servant.Docs.Internal.ToSample Swarm.Web.Worldview.GridResponse
+ Swarm.Doc.Command: CommandCatalog :: [CommandEntry] -> CommandCatalog
+ Swarm.Doc.Command: CommandEntry :: Const -> Set CommandEffect -> NonEmpty Type -> DerivedAttrs -> CommandEntry
+ Swarm.Doc.Command: DerivedAttrs :: Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> String -> DerivedAttrs
+ Swarm.Doc.Command: [argTypes] :: CommandEntry -> NonEmpty Type
+ Swarm.Doc.Command: [cmd] :: CommandEntry -> Const
+ Swarm.Doc.Command: [derivedAttrs] :: CommandEntry -> DerivedAttrs
+ Swarm.Doc.Command: [effects] :: CommandEntry -> Set CommandEffect
+ Swarm.Doc.Command: [entries] :: CommandCatalog -> [CommandEntry]
+ Swarm.Doc.Command: [hasActorTarget] :: DerivedAttrs -> Bool
+ Swarm.Doc.Command: [modifiesEnvironment] :: DerivedAttrs -> Bool
+ Swarm.Doc.Command: [modifiesRobot] :: DerivedAttrs -> Bool
+ Swarm.Doc.Command: [movesRobot] :: DerivedAttrs -> Bool
+ Swarm.Doc.Command: [outputType] :: DerivedAttrs -> String
+ Swarm.Doc.Command: [pureComputation] :: DerivedAttrs -> Bool
+ Swarm.Doc.Command: [returnsValue] :: DerivedAttrs -> Bool
+ Swarm.Doc.Command: data CommandEntry
+ Swarm.Doc.Command: data DerivedAttrs
+ Swarm.Doc.Command: getCatalog :: CommandCatalog
+ Swarm.Doc.Command: instance Data.Aeson.Types.ToJSON.ToJSON Swarm.Doc.Command.CommandCatalog
+ Swarm.Doc.Command: instance Data.Aeson.Types.ToJSON.ToJSON Swarm.Doc.Command.CommandEntry
+ Swarm.Doc.Command: instance Data.Aeson.Types.ToJSON.ToJSON Swarm.Doc.Command.DerivedAttrs
+ Swarm.Doc.Command: instance GHC.Generics.Generic Swarm.Doc.Command.CommandCatalog
+ Swarm.Doc.Command: instance GHC.Generics.Generic Swarm.Doc.Command.CommandEntry
+ Swarm.Doc.Command: instance GHC.Generics.Generic Swarm.Doc.Command.DerivedAttrs
+ Swarm.Doc.Command: instance Servant.Docs.Internal.ToSample Swarm.Doc.Command.CommandCatalog
+ Swarm.Doc.Command: mkEntry :: Const -> CommandEntry
+ Swarm.Doc.Command: newtype CommandCatalog
+ Swarm.Doc.Gen: Capabilities :: SheetType
+ Swarm.Doc.Gen: CommandMatrix :: SheetType
+ Swarm.Doc.Gen: Commands :: SheetType
+ Swarm.Doc.Gen: Entities :: SheetType
+ Swarm.Doc.Gen: FilterForward :: EdgeFilter
+ Swarm.Doc.Gen: FilterNext :: EdgeFilter
+ Swarm.Doc.Gen: NoFilter :: EdgeFilter
+ Swarm.Doc.Gen: PageAddress :: Text -> Text -> Text -> Text -> PageAddress
+ Swarm.Doc.Gen: Recipes :: SheetType
+ Swarm.Doc.Gen: Scenario :: SheetType
+ Swarm.Doc.Gen: Terrain :: SheetType
+ Swarm.Doc.Gen: [CheatSheet] :: PageAddress -> SheetType -> GenerateDocs
+ Swarm.Doc.Gen: [CommandsData] :: GenerateDocs
+ Swarm.Doc.Gen: [EditorKeywords] :: Maybe EditorType -> GenerateDocs
+ Swarm.Doc.Gen: [RecipeGraph] :: EdgeFilter -> GenerateDocs
+ Swarm.Doc.Gen: [SpecialKeyNames] :: GenerateDocs
+ Swarm.Doc.Gen: [TutorialCoverage] :: GenerateDocs
+ Swarm.Doc.Gen: [capabilityAddress] :: PageAddress -> Text
+ Swarm.Doc.Gen: [commandsAddress] :: PageAddress -> Text
+ Swarm.Doc.Gen: [entityAddress] :: PageAddress -> Text
+ Swarm.Doc.Gen: [recipesAddress] :: PageAddress -> Text
+ Swarm.Doc.Gen: data EdgeFilter
+ Swarm.Doc.Gen: data GenerateDocs
+ Swarm.Doc.Gen: data PageAddress
+ Swarm.Doc.Gen: data SheetType
+ Swarm.Doc.Gen: generateDocs :: GenerateDocs -> IO ()
+ Swarm.Doc.Gen: instance GHC.Classes.Eq Swarm.Doc.Gen.EdgeFilter
+ Swarm.Doc.Gen: instance GHC.Classes.Eq Swarm.Doc.Gen.GenerateDocs
+ Swarm.Doc.Gen: instance GHC.Show.Show Swarm.Doc.Gen.EdgeFilter
+ Swarm.Doc.Gen: instance GHC.Show.Show Swarm.Doc.Gen.GenerateDocs
+ Swarm.Doc.Keyword: Emacs :: EditorType
+ Swarm.Doc.Keyword: VSCode :: EditorType
+ Swarm.Doc.Keyword: Vim :: EditorType
+ Swarm.Doc.Keyword: builtinFunctionList :: EditorType -> Text
+ Swarm.Doc.Keyword: data EditorType
+ Swarm.Doc.Keyword: instance GHC.Classes.Eq Swarm.Doc.Keyword.EditorType
+ Swarm.Doc.Keyword: instance GHC.Enum.Bounded Swarm.Doc.Keyword.EditorType
+ Swarm.Doc.Keyword: instance GHC.Enum.Enum Swarm.Doc.Keyword.EditorType
+ Swarm.Doc.Keyword: instance GHC.Show.Show Swarm.Doc.Keyword.EditorType
+ Swarm.Doc.Keyword: keywordsCommands :: EditorType -> Text
+ Swarm.Doc.Keyword: keywordsDirections :: EditorType -> Text
+ Swarm.Doc.Keyword: operatorNames :: EditorType -> Text
+ Swarm.Doc.Pedagogy: CoverageInfo :: TutorialInfo -> Map Const [SrcLoc] -> CoverageInfo
+ Swarm.Doc.Pedagogy: TutorialInfo :: ScenarioWith ScenarioPath -> Int -> Map Const [SrcLoc] -> Set Const -> TutorialInfo
+ Swarm.Doc.Pedagogy: [descriptionCommands] :: TutorialInfo -> Set Const
+ Swarm.Doc.Pedagogy: [novelSolutionCommands] :: CoverageInfo -> Map Const [SrcLoc]
+ Swarm.Doc.Pedagogy: [scenarioPair] :: TutorialInfo -> ScenarioWith ScenarioPath
+ Swarm.Doc.Pedagogy: [solutionCommands] :: TutorialInfo -> Map Const [SrcLoc]
+ Swarm.Doc.Pedagogy: [tutIndex] :: TutorialInfo -> Int
+ Swarm.Doc.Pedagogy: [tutInfo] :: CoverageInfo -> TutorialInfo
+ Swarm.Doc.Pedagogy: data CoverageInfo
+ Swarm.Doc.Pedagogy: data TutorialInfo
+ Swarm.Doc.Pedagogy: generateIntroductionsSequence :: ScenarioCollection ScenarioInfo -> [CoverageInfo]
+ Swarm.Doc.Pedagogy: renderTutorialProgression :: IO Text
+ Swarm.Doc.Schema.Arrangement: sortAndPruneSchemas :: SchemaIdReference -> [SchemaData] -> [SchemaData]
+ Swarm.Doc.Schema.Parse: EnumMembers :: NonEmpty Text -> Members
+ Swarm.Doc.Schema.Parse: ListMembers :: ItemDescription SwarmSchema -> Members
+ Swarm.Doc.Schema.Parse: ObjectProperties :: Map Text SwarmSchema -> Members
+ Swarm.Doc.Schema.Parse: SchemaData :: FilePath -> ToplevelSchema -> [Pandoc] -> SchemaData
+ Swarm.Doc.Schema.Parse: ToplevelSchema :: Text -> Maybe Pandoc -> SwarmSchema -> Maybe Members -> [FilePath] -> ToplevelSchema
+ Swarm.Doc.Schema.Parse: [content] :: ToplevelSchema -> SwarmSchema
+ Swarm.Doc.Schema.Parse: [description] :: ToplevelSchema -> Maybe Pandoc
+ Swarm.Doc.Schema.Parse: [footerPaths] :: ToplevelSchema -> [FilePath]
+ Swarm.Doc.Schema.Parse: [markdownFooters] :: SchemaData -> [Pandoc]
+ Swarm.Doc.Schema.Parse: [members] :: ToplevelSchema -> Maybe Members
+ Swarm.Doc.Schema.Parse: [schemaContent] :: SchemaData -> ToplevelSchema
+ Swarm.Doc.Schema.Parse: [schemaPath] :: SchemaData -> FilePath
+ Swarm.Doc.Schema.Parse: [title] :: ToplevelSchema -> Text
+ Swarm.Doc.Schema.Parse: data Members
+ Swarm.Doc.Schema.Parse: data SchemaData
+ Swarm.Doc.Schema.Parse: data ToplevelSchema
+ Swarm.Doc.Schema.Parse: instance Data.Aeson.Types.FromJSON.FromJSON Swarm.Doc.Schema.Parse.ToplevelSchema
+ Swarm.Doc.Schema.Parse: instance GHC.Classes.Eq Swarm.Doc.Schema.Parse.Members
+ Swarm.Doc.Schema.Parse: instance GHC.Classes.Eq Swarm.Doc.Schema.Parse.ToplevelSchema
+ Swarm.Doc.Schema.Parse: instance GHC.Classes.Ord Swarm.Doc.Schema.Parse.Members
+ Swarm.Doc.Schema.Parse: instance GHC.Classes.Ord Swarm.Doc.Schema.Parse.ToplevelSchema
+ Swarm.Doc.Schema.Parse: instance GHC.Show.Show Swarm.Doc.Schema.Parse.Members
+ Swarm.Doc.Schema.Parse: instance GHC.Show.Show Swarm.Doc.Schema.Parse.ToplevelSchema
+ Swarm.Doc.Schema.Refined: ItemList :: [a] -> ItemDescription a
+ Swarm.Doc.Schema.Refined: ItemType :: a -> ItemDescription a
+ Swarm.Doc.Schema.Refined: SchemaRaw :: Maybe Text -> Maybe Value -> Maybe Text -> Maybe (SingleOrList Text) -> Maybe Text -> Maybe (Map Text SwarmSchema) -> Maybe (ItemDescription SwarmSchema) -> Maybe [Value] -> Maybe Text -> Maybe [SchemaRaw] -> Maybe [FilePath] -> Maybe Bool -> Maybe (NonEmpty Text) -> SchemaRaw
+ Swarm.Doc.Schema.Refined: SwarmSchema :: SchemaType -> Maybe Value -> Maybe Pandoc -> Maybe (Map Text SwarmSchema) -> Maybe (ItemDescription SwarmSchema) -> [Value] -> SwarmSchema
+ Swarm.Doc.Schema.Refined: [_Sref] :: SchemaRaw -> Maybe Text
+ Swarm.Doc.Schema.Refined: [_additionalProperties] :: SchemaRaw -> Maybe Bool
+ Swarm.Doc.Schema.Refined: [_default] :: SchemaRaw -> Maybe Value
+ Swarm.Doc.Schema.Refined: [_description] :: SchemaRaw -> Maybe Text
+ Swarm.Doc.Schema.Refined: [_enum] :: SchemaRaw -> Maybe (NonEmpty Text)
+ Swarm.Doc.Schema.Refined: [_examples] :: SchemaRaw -> Maybe [Value]
+ Swarm.Doc.Schema.Refined: [_footers] :: SchemaRaw -> Maybe [FilePath]
+ Swarm.Doc.Schema.Refined: [_items] :: SchemaRaw -> Maybe (ItemDescription SwarmSchema)
+ Swarm.Doc.Schema.Refined: [_name] :: SchemaRaw -> Maybe Text
+ Swarm.Doc.Schema.Refined: [_oneOf] :: SchemaRaw -> Maybe [SchemaRaw]
+ Swarm.Doc.Schema.Refined: [_properties] :: SchemaRaw -> Maybe (Map Text SwarmSchema)
+ Swarm.Doc.Schema.Refined: [_title] :: SchemaRaw -> Maybe Text
+ Swarm.Doc.Schema.Refined: [_type] :: SchemaRaw -> Maybe (SingleOrList Text)
+ Swarm.Doc.Schema.Refined: [defaultValue] :: SwarmSchema -> Maybe Value
+ Swarm.Doc.Schema.Refined: [examples] :: SwarmSchema -> [Value]
+ Swarm.Doc.Schema.Refined: [itemsDescription] :: SwarmSchema -> Maybe (ItemDescription SwarmSchema)
+ Swarm.Doc.Schema.Refined: [objectDescription] :: SwarmSchema -> Maybe Pandoc
+ Swarm.Doc.Schema.Refined: [properties] :: SwarmSchema -> Maybe (Map Text SwarmSchema)
+ Swarm.Doc.Schema.Refined: [schemaType] :: SwarmSchema -> SchemaType
+ Swarm.Doc.Schema.Refined: data ItemDescription a
+ Swarm.Doc.Schema.Refined: data SchemaRaw
+ Swarm.Doc.Schema.Refined: data SwarmSchema
+ Swarm.Doc.Schema.Refined: extractReferences :: SwarmSchema -> Set SchemaIdReference
+ Swarm.Doc.Schema.Refined: extractSchemaType :: SchemaRaw -> Maybe SchemaType
+ Swarm.Doc.Schema.Refined: getMarkdown :: MonadFail m => Text -> m Pandoc
+ Swarm.Doc.Schema.Refined: getSchemaReferences :: SchemaType -> [SchemaIdReference]
+ Swarm.Doc.Schema.Refined: instance Data.Aeson.Types.FromJSON.FromJSON Swarm.Doc.Schema.Refined.SchemaRaw
+ Swarm.Doc.Schema.Refined: instance Data.Aeson.Types.FromJSON.FromJSON Swarm.Doc.Schema.Refined.SwarmSchema
+ Swarm.Doc.Schema.Refined: instance Data.Aeson.Types.FromJSON.FromJSON a => Data.Aeson.Types.FromJSON.FromJSON (Swarm.Doc.Schema.Refined.ItemDescription a)
+ Swarm.Doc.Schema.Refined: instance GHC.Classes.Eq Swarm.Doc.Schema.Refined.SchemaRaw
+ Swarm.Doc.Schema.Refined: instance GHC.Classes.Eq Swarm.Doc.Schema.Refined.SwarmSchema
+ Swarm.Doc.Schema.Refined: instance GHC.Classes.Eq a => GHC.Classes.Eq (Swarm.Doc.Schema.Refined.ItemDescription a)
+ Swarm.Doc.Schema.Refined: instance GHC.Classes.Ord Swarm.Doc.Schema.Refined.SchemaRaw
+ Swarm.Doc.Schema.Refined: instance GHC.Classes.Ord Swarm.Doc.Schema.Refined.SwarmSchema
+ Swarm.Doc.Schema.Refined: instance GHC.Classes.Ord a => GHC.Classes.Ord (Swarm.Doc.Schema.Refined.ItemDescription a)
+ Swarm.Doc.Schema.Refined: instance GHC.Generics.Generic Swarm.Doc.Schema.Refined.SchemaRaw
+ Swarm.Doc.Schema.Refined: instance GHC.Show.Show Swarm.Doc.Schema.Refined.SchemaRaw
+ Swarm.Doc.Schema.Refined: instance GHC.Show.Show Swarm.Doc.Schema.Refined.SwarmSchema
+ Swarm.Doc.Schema.Refined: instance GHC.Show.Show a => GHC.Show.Show (Swarm.Doc.Schema.Refined.ItemDescription a)
+ Swarm.Doc.Schema.Refined: schemaJsonOptions :: Options
+ Swarm.Doc.Schema.Refined: toSwarmSchema :: MonadFail m => SchemaRaw -> m SwarmSchema
+ Swarm.Doc.Schema.Render: docFragmentsDir :: FilePath
+ Swarm.Doc.Schema.Render: formatNumberCompact :: Scientific -> String
+ Swarm.Doc.Schema.Render: fragmentHref :: Map SchemaIdReference Text -> SchemaIdReference -> Text
+ Swarm.Doc.Schema.Render: genMarkdown :: [SchemaData] -> Either Text Text
+ Swarm.Doc.Schema.Render: genPropsRow :: Bool -> Map SchemaIdReference Text -> (Text, SwarmSchema) -> [Blocks]
+ Swarm.Doc.Schema.Render: genScenarioSchemaDocs :: IO ()
+ Swarm.Doc.Schema.Render: listColumnHeadings :: [Text]
+ Swarm.Doc.Schema.Render: listToText :: Map SchemaIdReference Text -> SchemaType -> Inlines
+ Swarm.Doc.Schema.Render: loadFooterContent :: (FilePath, ToplevelSchema) -> IO SchemaData
+ Swarm.Doc.Schema.Render: makePandocTable :: Map SchemaIdReference Text -> SchemaData -> Pandoc
+ Swarm.Doc.Schema.Render: makePropsTable :: Bool -> [Text] -> Map SchemaIdReference Text -> Map Text SwarmSchema -> Blocks
+ Swarm.Doc.Schema.Render: makeTitleMap :: [SchemaData] -> Map SchemaIdReference Text
+ Swarm.Doc.Schema.Render: parseSchemaFile :: FileStemAndExtension -> IO (Either Text ToplevelSchema)
+ Swarm.Doc.Schema.Render: propertyColumnHeadings :: [Text]
+ Swarm.Doc.Schema.Render: recombineExtension :: FileStemAndExtension -> FilePath
+ Swarm.Doc.Schema.Render: renderValue :: Value -> Text
+ Swarm.Doc.Schema.Render: scenariosDir :: FilePath
+ Swarm.Doc.Schema.Render: schemaExtension :: String
+ Swarm.Doc.Schema.Render: schemasDir :: FilePath
+ Swarm.Doc.Schema.Render: type FileStemAndExtension = (FilePath, String)
+ Swarm.Doc.Schema.SchemaType: Alternatives :: [SchemaType] -> SchemaType
+ Swarm.Doc.Schema.SchemaType: EnumList :: NonEmpty Text -> SchemaType
+ Swarm.Doc.Schema.SchemaType: ListOf :: SchemaType -> SchemaType
+ Swarm.Doc.Schema.SchemaType: Reference :: SchemaIdReference -> SchemaType
+ Swarm.Doc.Schema.SchemaType: SchemaIdReference :: Text -> SchemaIdReference
+ Swarm.Doc.Schema.SchemaType: Simple :: SingleOrList Text -> SchemaType
+ Swarm.Doc.Schema.SchemaType: SingleOrList :: [a] -> SingleOrList a
+ Swarm.Doc.Schema.SchemaType: [getList] :: SingleOrList a -> [a]
+ Swarm.Doc.Schema.SchemaType: data SchemaType
+ Swarm.Doc.Schema.SchemaType: fromFilePath :: FilePath -> SchemaIdReference
+ Swarm.Doc.Schema.SchemaType: instance Data.Aeson.Types.FromJSON.FromJSON a => Data.Aeson.Types.FromJSON.FromJSON (Swarm.Doc.Schema.SchemaType.SingleOrList a)
+ Swarm.Doc.Schema.SchemaType: instance GHC.Classes.Eq Swarm.Doc.Schema.SchemaType.SchemaIdReference
+ Swarm.Doc.Schema.SchemaType: instance GHC.Classes.Eq Swarm.Doc.Schema.SchemaType.SchemaType
+ Swarm.Doc.Schema.SchemaType: instance GHC.Classes.Eq a => GHC.Classes.Eq (Swarm.Doc.Schema.SchemaType.SingleOrList a)
+ Swarm.Doc.Schema.SchemaType: instance GHC.Classes.Ord Swarm.Doc.Schema.SchemaType.SchemaIdReference
+ Swarm.Doc.Schema.SchemaType: instance GHC.Classes.Ord Swarm.Doc.Schema.SchemaType.SchemaType
+ Swarm.Doc.Schema.SchemaType: instance GHC.Classes.Ord a => GHC.Classes.Ord (Swarm.Doc.Schema.SchemaType.SingleOrList a)
+ Swarm.Doc.Schema.SchemaType: instance GHC.Show.Show Swarm.Doc.Schema.SchemaType.SchemaIdReference
+ Swarm.Doc.Schema.SchemaType: instance GHC.Show.Show Swarm.Doc.Schema.SchemaType.SchemaType
+ Swarm.Doc.Schema.SchemaType: instance GHC.Show.Show a => GHC.Show.Show (Swarm.Doc.Schema.SchemaType.SingleOrList a)
+ Swarm.Doc.Schema.SchemaType: newtype SchemaIdReference
+ Swarm.Doc.Schema.SchemaType: newtype SingleOrList a
+ Swarm.Doc.Util: addLink :: Text -> Text -> Text
+ Swarm.Doc.Util: builtinFunctions :: [Const]
+ Swarm.Doc.Util: codeQuote :: Text -> Text
+ Swarm.Doc.Util: commands :: [Const]
+ Swarm.Doc.Util: constSyntax :: Const -> Text
+ Swarm.Doc.Util: operators :: [Const]
+ Swarm.Doc.Util: wrap :: Char -> Text -> Text
+ Swarm.Doc.Wiki.Cheatsheet: Capabilities :: SheetType
+ Swarm.Doc.Wiki.Cheatsheet: CommandMatrix :: SheetType
+ Swarm.Doc.Wiki.Cheatsheet: Commands :: SheetType
+ Swarm.Doc.Wiki.Cheatsheet: Entities :: SheetType
+ Swarm.Doc.Wiki.Cheatsheet: PageAddress :: Text -> Text -> Text -> Text -> PageAddress
+ Swarm.Doc.Wiki.Cheatsheet: Recipes :: SheetType
+ Swarm.Doc.Wiki.Cheatsheet: Scenario :: SheetType
+ Swarm.Doc.Wiki.Cheatsheet: Terrain :: SheetType
+ Swarm.Doc.Wiki.Cheatsheet: [capabilityAddress] :: PageAddress -> Text
+ Swarm.Doc.Wiki.Cheatsheet: [commandsAddress] :: PageAddress -> Text
+ Swarm.Doc.Wiki.Cheatsheet: [entityAddress] :: PageAddress -> Text
+ Swarm.Doc.Wiki.Cheatsheet: [recipesAddress] :: PageAddress -> Text
+ Swarm.Doc.Wiki.Cheatsheet: data PageAddress
+ Swarm.Doc.Wiki.Cheatsheet: data SheetType
+ Swarm.Doc.Wiki.Cheatsheet: instance GHC.Classes.Eq Swarm.Doc.Wiki.Cheatsheet.PageAddress
+ Swarm.Doc.Wiki.Cheatsheet: instance GHC.Classes.Eq Swarm.Doc.Wiki.Cheatsheet.SheetType
+ Swarm.Doc.Wiki.Cheatsheet: instance GHC.Enum.Bounded Swarm.Doc.Wiki.Cheatsheet.SheetType
+ Swarm.Doc.Wiki.Cheatsheet: instance GHC.Enum.Enum Swarm.Doc.Wiki.Cheatsheet.SheetType
+ Swarm.Doc.Wiki.Cheatsheet: instance GHC.Show.Show Swarm.Doc.Wiki.Cheatsheet.PageAddress
+ Swarm.Doc.Wiki.Cheatsheet: instance GHC.Show.Show Swarm.Doc.Wiki.Cheatsheet.SheetType
+ Swarm.Doc.Wiki.Cheatsheet: makeWikiPage :: PageAddress -> SheetType -> IO ()
+ Swarm.Doc.Wiki.Matrix: commandsMatrix :: Pandoc
+ Swarm.Doc.Wiki.Matrix: genPropsRow :: CommandEntry -> [Blocks]
+ Swarm.Doc.Wiki.Matrix: makePropsTable :: [Text] -> Blocks
+ Swarm.Doc.Wiki.Util: pandocToText :: Pandoc -> Either Text Text

This diff is very large; some files are shown as “too large to diff”. Download the raw patch for the complete diff.

Files

CHANGELOG.md view
@@ -1,5 +1,124 @@ # Revision history for swarm +## **0.7.0.0** - 2025-06-03++### Breaking changes++* `return` has been renamed to `pure` ([#2285](https://github.com/swarm-game/swarm/pull/2285))+* `fst`/`snd` have been removed in favor of a pair eliminator called `match` ([#2407](https://github.com/swarm-game/swarm/pull/2407))+* `require <n> <item>` has been renamed to `stock <n> <item>` to reduce ambiguity with `require <device>` ([#2455](https://github.com/swarm-game/swarm/pull/2455)).++You can use `swarm format --v0.6` to automatically convert old code.++### Bugfixes++* Report cycles correctly in error messages ([#2199](https://github.com/swarm-game/swarm/pull/2199))+* Validate hex colors in `FromJSON` instance ([#2237](https://github.com/swarm-game/swarm/pull/2237))+* Make custom entities override built-in entities ([#2241](https://github.com/swarm-game/swarm/pull/2241))+* Make `halt`ed robots immediately wake up ([#2254](https://github.com/swarm-game/swarm/pull/2254))+* Don't update scenario completion stats after scenario completion ([#2256](https://github.com/swarm-game/swarm/pull/2256))+* Only `meet` interactive robots ([#2262](https://github.com/swarm-game/swarm/pull/2262))+* Evaluate argument to `instant`/`atomic` atomically ([#2271](https://github.com/swarm-game/swarm/pull/2271))+* Fix type inference for recursive let bindings ([#2187](https://github.com/swarm-game/swarm/pull/2187))+* Fix two space leaks ([#2448](https://github.com/swarm-game/swarm/pull/2448))+* Fix robot modal memory leak by only rendering modal when it is displayed ([#2379](https://github.com/swarm-game/swarm/pull/2379))+* Fix completed scenarios so they always show green status ([#2312](https://github.com/swarm-game/swarm/pull/2312))+* Fix shadowing for user-defined types ([#2450](https://github.com/swarm-game/swarm/pull/2450))++### Features + Enhancements++#### New commands++* `print` + `erase` commands for printing on paper ([#2245](https://github.com/swarm-game/swarm/pull/2245))+* New `read` command to act as partial inverse to `format` ([#2224](https://github.com/swarm-game/swarm/pull/2224), [#2461](https://github.com/swarm-game/swarm/pull/2461))+* New subworld-aware teleportation and location query commands, `warp` and `locateme` ([#2195](https://github.com/swarm-game/swarm/pull/2195))++#### Language++* Improve type inference for record projection ([#2172](https://github.com/swarm-game/swarm/pull/2172))+* Scoped type variables ([#2178](https://github.com/swarm-game/swarm/pull/2178))+* Do requirements analysis for literal text argument to `use` ([#2211](https://github.com/swarm-game/swarm/pull/2211))+* Rename `return` to `pure` ([#2285](https://github.com/swarm-game/swarm/pull/2285))+* Replace `fst` and `snd` with pair eliminator `match` ([#2407](https://github.com/swarm-game/swarm/pull/2407))+* Rename `require n` to `stock` ([#2455](https://github.com/swarm-game/swarm/pull/2455))+* Custom error message for missing `end` (#1141) ([#2373](https://github.com/swarm-game/swarm/pull/2373))+* Use original variable names in error messages about Skolem variables ([#2340](https://github.com/swarm-game/swarm/pull/2340))++#### Entities + Recipes++* Make `rolex` show time ([#2147](https://github.com/swarm-game/swarm/pull/2147))+* `atlas` entity ([#2257](https://github.com/swarm-game/swarm/pull/2257))+* Recipes for `binoculars` ([#2391](https://github.com/swarm-game/swarm/pull/2391))+* `water` disappears when placed ([#2358](https://github.com/swarm-game/swarm/pull/2358))++#### Tutorials + Scenarios++* Make `Tutorial` menu choice auto-start first *unsolved* tutorial scenario ([#2314](https://github.com/swarm-game/swarm/pull/2314))+* Add some optional goals to the classic scenario ([#2436](https://github.com/swarm-game/swarm/pull/2436))+* A number of small tutorial improvements+  ([#2406](https://github.com/swarm-game/swarm/pull/2406),+  [#2405](https://github.com/swarm-game/swarm/pull/2405),+  [#2404](https://github.com/swarm-game/swarm/pull/2404),+  [#2409](https://github.com/swarm-game/swarm/pull/2409),+  [#2421](https://github.com/swarm-game/swarm/pull/2421),+  [#2361](https://github.com/swarm-game/swarm/pull/2361),+  [#2359](https://github.com/swarm-game/swarm/pull/2359),+  [#2444](https://github.com/swarm-game/swarm/pull/2444))+* Progress bar vignette ([#2190](https://github.com/swarm-game/swarm/pull/2190))+* Counting flowers ([#2249](https://github.com/swarm-game/swarm/pull/2249))+* Spiders demo ([#2275](https://github.com/swarm-game/swarm/pull/2275))+* Dictionary implementation + benchmark ([#2191](https://github.com/swarm-game/swarm/pull/2191))+* Get rid of "world offset" + add burned patch around base in classic scenario ([#2344](https://github.com/swarm-game/swarm/pull/2344))+* DNA copying challenge ([#1031](https://github.com/swarm-game/swarm/pull/1031))+* Exterminator scenario ([#2126](https://github.com/swarm-game/swarm/pull/2126))++#### Achievements++* Achievement for completing all tutorials ([#2354](https://github.com/swarm-game/swarm/pull/2354))+* Grant `AttemptSelfDestructBase` achievement for movement as well as `selfdestruct` ([#2356](https://github.com/swarm-game/swarm/pull/2356))+* Swiss Army Robot achievement for equipping all craftable devices in classic game ([#2424](https://github.com/swarm-game/swarm/pull/2424))++#### Scenario mechanics and authoring improvements++* Refactor + comment `World Examples/clearing` to make it easier to understand ([#2305](https://github.com/swarm-game/swarm/pull/2305))+* New combustion delay parameter ([#2248](https://github.com/swarm-game/swarm/pull/2248))+* Structure enhancements+    * Demo standalone colored structures ([#2099](https://github.com/swarm-game/swarm/pull/2099))+    * ensure no overlaps in initial placement of recognized structures ([#2212](https://github.com/swarm-game/swarm/pull/2212))+    * shape recognition with piecewise rows ([#2201](https://github.com/swarm-game/swarm/pull/2201))+    * Fix shape recognition orientation edge case ([#2229](https://github.com/swarm-game/swarm/pull/2229))+* Render contiguous boundaries ([#1285](https://github.com/swarm-game/swarm/pull/1285)) and remove old individual wall entities ([#2328](https://github.com/swarm-game/swarm/pull/2328))++#### UI enhancements++* Pause on objective completion ([#2096](https://github.com/swarm-game/swarm/pull/2096))+* Navigable robots table ([#2140](https://github.com/swarm-game/swarm/pull/2140))+* Expose waypoint and portal info to web API ([#2185](https://github.com/swarm-game/swarm/pull/2185))+* Warn the user when debugging options are on ([#2278](https://github.com/swarm-game/swarm/pull/2278))+* Scenarios started from command line now quit directly back to command line ([#2280](https://github.com/swarm-game/swarm/pull/2280))+* Make FPS toggle and "recenter view" into global events ([#2293](https://github.com/swarm-game/swarm/pull/2293))+* Minimize list of required device sets in error messages ([#2299](https://github.com/swarm-game/swarm/pull/2299))+* Clickable shortcuts in TUI ([#2324](https://github.com/swarm-game/swarm/pull/2324))+* Don't re-validate REPL input when moving the cursor left or right ([#2365](https://github.com/swarm-game/swarm/pull/2365))+* Legend for colorization in F1 dialog ([#2175](https://github.com/swarm-game/swarm/pull/2175))+* Render map preview as dynamic PNG ([#2184](https://github.com/swarm-game/swarm/pull/2184))+* Don't insert extra close bracket when the cursor is already on top of one ([#2215](https://github.com/swarm-game/swarm/pull/2215))+* Add Replay game script ([#2446](https://github.com/swarm-game/swarm/pull/2446))++#### Pretty printing + Formatting++* Put end on separate line when pretty printing definitions ([#2100](https://github.com/swarm-game/swarm/pull/2100))+* Improvements to comment preservation in `swarm format` ([#2329](https://github.com/swarm-game/swarm/pull/2329))++#### Command line options++* Add CLI option to start the game paused ([#2080](https://github.com/swarm-game/swarm/pull/2080))+* Split out debug options ([#2094](https://github.com/swarm-game/swarm/pull/2094))++### Building/packaging++* Add support for GHC 9.10 and 9.12, and drop 9.2 and 9.4+ ## **0.6.0.0** - 2024-07-15  Some of the highlights of this release include native Windows support,@@ -396,7 +515,7 @@ - scenarios which can be loaded from YAML files   - the release comes with official challenges and an in-game tutorial   - the default Classic and Creative modes use the same YAML syntax-  - we include JSON schemas for editor support when writing scenarios +  - we include JSON schemas for editor support when writing scenarios - procedural 2D world generation - LSP server built into the Swarm executable - Terminal UI interface
− app/Main.hs 
@@ -1,169 +0,0 @@-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TemplateHaskell #-}---- |--- SPDX-License-Identifier: BSD-3-Clause-module Main where--import Control.Monad (when)-import Data.Foldable qualified-import Data.Text.IO qualified as T-import GitHash (GitInfo, giBranch, giHash, tGitInfoCwdTry)-import Options.Applicative-import Swarm.App (appMain)-import Swarm.Game.ResourceLoading (getSwarmConfigIniFile)-import Swarm.Language.Format-import Swarm.Language.LSP (lspMain)-import Swarm.Language.Parser.Core (LanguageVersion (..))-import Swarm.TUI.Model (AppOpts (..), ColorMode (..))-import Swarm.TUI.Model.KeyBindings (KeybindingPrint (..), showKeybindings)-import Swarm.TUI.Model.UI (defaultInitLgTicksPerSecond)-import Swarm.Version-import Swarm.Web (defaultPort)-import System.IO (hPrint, stderr)-import Text.Read (readMaybe)--gitInfo :: Maybe GitInfo-gitInfo = either (const Nothing) Just $$tGitInfoCwdTry--commitInfo :: String-commitInfo = case gitInfo of-  Nothing -> ""-  Just git -> " (" <> giBranch git <> "@" <> take 10 (giHash git) <> ")"--data CLI-  = Run AppOpts-  | -- | Print list of bindings, optionally initializing the INI configuration file.-    ListKeybinding Bool KeybindingPrint-  | Format FormatConfig-  | LSP-  | Version--cliParser :: Parser CLI-cliParser =-  subparser-    ( mconcat-        [ command "format" (info (Format <$> parseFormat) (progDesc "Format a file"))-        , command "lsp" (info (pure LSP) (progDesc "Start the LSP"))-        , command "version" (info (pure Version) (progDesc "Get current and upstream version."))-        , command "keybindings" (info (ListKeybinding <$> initKeybindingConfig <*> printKeyMode <**> helper) (progDesc "List the keybindings"))-        ]-    )-    <|> Run-      <$> ( AppOpts-              <$> seed-              <*> scenario-              <*> run-              <*> autoplay-              <*> speedFactor-              <*> cheat-              <*> color-              <*> webPort-              <*> pure gitInfo-          )- where-  input :: Parser FormatInput-  input =-    flag' Stdin (long "stdin" <> help "Read code from stdin")-      <|> (InputFile <$> strArgument (metavar "FILE"))--  output :: Parser FormatOutput-  output =-    flag Stdout Stdout (long "stdout" <> help "Write formatted code to stdout (default)")-      <|> (OutputFile <$> strOption (long "output" <> short 'o' <> metavar "FILE" <> help "Write formatted code to an output file"))-      <|> flag' Inplace (long "inplace" <> short 'i' <> help "Format file in place")--  widthOpt :: Parser FormatWidth-  widthOpt = option auto (long "width" <> metavar "COLUMNS" <> help "Use layout with maximum width")--  langVer :: Parser LanguageVersion-  langVer = flag SwarmLangLatest SwarmLang0_5 (long "v0.5" <> help "Read (& convert) code from Swarm version 0.5")--  printKeyMode :: Parser KeybindingPrint-  printKeyMode =-    flag' IniPrint (long "ini" <> help "Print in INI format")-      <|> flag' MarkdownPrint (long "markdown" <> help "Print in Markdown table format")-      <|> pure TextPrint--  initKeybindingConfig :: Parser Bool-  initKeybindingConfig = switch (short 'i' <> long "init" <> help "Initialise the keybindings configuration file")--  parseFormat :: Parser FormatConfig-  parseFormat = FormatConfig <$> input <*> output <*> optional widthOpt <*> langVer <**> helper--  seed :: Parser (Maybe Int)-  seed = optional $ option auto (long "seed" <> short 's' <> metavar "INT" <> help "Seed to use for world generation")--  webPort :: Parser (Maybe Int)-  webPort =-    optional $-      option-        auto-        ( long "web"-            <> metavar "PORT"-            <> help ("Set the web service port (or disable it with 0). Default to " <> show defaultPort <> ".")-        )-  scenario :: Parser (Maybe String)-  scenario = optional $ strOption (long "scenario" <> short 'i' <> metavar "FILE" <> help "Name of an input scenario to load")-  run :: Parser (Maybe String)-  run = optional $ strOption (long "run" <> short 'r' <> metavar "FILE" <> help "Run the commands in a file at startup")-  autoplay :: Parser Bool-  autoplay = switch (long "autoplay" <> short 'a' <> help "Automatically run the solution defined in the scenario, if there is one. Mutually exclusive with --run.")-  speedFactor :: Parser Int-  speedFactor = option auto (long "speed" <> short 'm' <> value defaultInitLgTicksPerSecond <> help "Initial game speed multiplier")-  cheat :: Parser Bool-  cheat = switch (long "cheat" <> short 'x' <> help "Enable cheat mode. This allows toggling Creative Mode with Ctrl+v and unlocks \"Testing\" scenarios in the menu.")-  color :: Parser (Maybe ColorMode)-  color = optional $ option colorModeParser (long "color" <> short 'c' <> metavar "MODE" <> help "Use none/8/16/full color mode.")-  colorModeParser =-    Data.Foldable.asum-      [ ColorMode8 <$ text "8"-      , ColorMode16 <$ text "16"-      , ColorMode240 <$> maybeReader (\case ('2' : '4' : '0' : '_' : w) -> readMaybe w; _ -> Nothing)-      , FullColor <$ text "full"-      , NoColor <$ text "none"-      ]-  text t = maybeReader (\x -> if x == t then Just x else Nothing)--cliInfo :: ParserInfo CLI-cliInfo =-  info-    (cliParser <**> helper)-    ( header ("Swarm game - " <> version <> commitInfo)-        <> progDesc "To play the game simply run without any command."-        <> fullDesc-    )--showVersion :: IO ()-showVersion = do-  putStrLn $ "Swarm game - " <> version <> commitInfo-  up <- getNewerReleaseVersion gitInfo-  either (hPrint stderr) (putStrLn . ("New upstream release: " <>)) up--printKeybindings :: Bool -> KeybindingPrint -> IO ()-printKeybindings initialize p = do-  kb <- showKeybindings p-  T.putStrLn kb-  (iniExists, ini) <- getSwarmConfigIniFile initialize-  when initialize $ do-    kbi <- showKeybindings IniPrint-    T.writeFile ini kbi-  let iniState-        | iniExists && initialize = "has been updated"-        | iniExists = "is"-        | initialize = "has been created"-        | otherwise = "can be created (--init)"-  putStrLn $ replicate 80 '-'-  putStrLn $ "The configuration file " <> iniState <> " at:"-  putStrLn ini--main :: IO ()-main = do-  cli <- execParser cliInfo-  case cli of-    Run opts -> appMain opts-    ListKeybinding initialize p -> printKeybindings initialize p-    Format cfg -> formatSwarmIO cfg-    LSP -> lspMain-    Version -> showVersion
− app/Swarm/App.hs 
@@ -1,153 +0,0 @@-{-# LANGUAGE NumericUnderscores #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeApplications #-}--{- HLINT ignore "Use underscore" -}---- |--- SPDX-License-Identifier: BSD-3-Clause--- Description: Application entry point------ Main entry point for the Swarm application.-module Swarm.App where--import Brick-import Brick.BChan-import Control.Carrier.Lift (runM)-import Control.Carrier.Throw.Either (runThrow)-import Control.Concurrent (forkIO, threadDelay)-import Control.Lens (view, (%~), (&), (?~))-import Control.Monad (forever, void, when)-import Control.Monad.IO.Class (liftIO)-import Data.IORef (newIORef, writeIORef)-import Data.Text qualified as T-import Data.Text.IO qualified as T-import Graphics.Vty qualified as V-import Graphics.Vty.CrossPlatform qualified as V-import Swarm.Game.Failure (SystemFailure)-import Swarm.Game.State.Runtime-import Swarm.Language.Pretty (prettyText)-import Swarm.Log (LogSource (SystemLog), Severity (..))-import Swarm.TUI.Controller-import Swarm.TUI.Model-import Swarm.TUI.Model.StateUpdate-import Swarm.TUI.Model.UI (uiAttrMap)-import Swarm.TUI.View-import Swarm.Util.ReadableIORef (mkReadonly)-import Swarm.Version (getNewerReleaseVersion)-import Swarm.Web-import System.IO (stderr)--type EventHandler = BrickEvent Name AppEvent -> EventM Name AppState ()---- | The configuration of the Swarm app which we pass to the @brick@---   library.-app :: EventHandler -> App AppState AppEvent Name-app eventHandler =-  App-    { appDraw = drawUI-    , appChooseCursor = chooseCursor-    , appHandleEvent = eventHandler-    , appStartEvent = enablePasteMode-    , appAttrMap = view $ uiState . uiAttrMap-    }---- | The main @IO@ computation which initializes the state, sets up---   some communication channels, and runs the UI.-appMain :: AppOpts -> IO ()-appMain opts = do-  res <- runM . runThrow $ initAppState opts-  case res of-    Left err -> T.hPutStrLn stderr (prettyText @SystemFailure err)-    Right s -> do-      -- Send Frame events as at a reasonable rate for 30 fps. The-      -- game is responsible for figuring out how many steps to take-      -- each frame to achieve the desired speed, regardless of the-      -- frame rate.  Note that if the game cannot keep up with 30-      -- fps, it's not a problem: the channel will fill up and this-      -- thread will block.  So the force of the threadDelay is just-      -- to set a *maximum* possible frame rate.-      ---      -- 5 is the size of the bounded channel; when it gets that big,-      -- any writes to it will block.  Probably 1 would work fine,-      -- though it seems like it could be good to have a bit of buffer-      -- just so the app never has to wait for the thread to wake up-      -- and do another write.--      chan <- newBChan 5-      _ <- forkIO $-        forever $ do-          threadDelay 33_333 -- cap maximum framerate at 30 FPS-          writeBChan chan Frame--      _ <- forkIO $ do-        upRel <- getNewerReleaseVersion (repoGitInfo opts)-        writeBChan chan (UpstreamVersion upRel)--      -- Start the web service with a reference to the game state.-      -- NOTE: This reference should be considered read-only by-      -- the web service; the game alone shall host the canonical state.-      appStateRef <- newIORef s-      eport <--        Swarm.Web.startWebThread-          (userWebPort opts)-          (mkReadonly appStateRef)-          chan--      let logP p = logEvent SystemLog Info "Web API" ("started on :" <> T.pack (show p))-      let logE e = logEvent SystemLog Error "Web API" (T.pack e)-      let s1 =-            s-              & runtimeState-                %~ case eport of-                  Right p -> (webPort ?~ p) . (eventLog %~ logP p)-                  Left e -> eventLog %~ logE e--      -- Update the reference for every event-      let eventHandler e = do-            curSt <- get-            liftIO $ writeIORef appStateRef curSt-            handleEvent e--      -- Setup virtual terminal-      let buildVty = V.mkVty V.defaultConfig {V.configPreferredColorMode = colorMode opts}-      vty <- buildVty--      V.setMode (V.outputIface vty) V.Mouse True--      let cm = V.outputColorMode $ V.outputIface vty-      let s2 =-            s1-              & runtimeState . eventLog %~ logEvent SystemLog Info "Graphics" ("Color mode: " <> T.pack (show cm))--      -- Run the app.-      void $ customMain vty buildVty (Just chan) (app eventHandler) s2---- | A demo program to run the web service directly, without the terminal application.---   This is useful to live update the code using @ghcid -W --test "Swarm.App.demoWeb"@.-demoWeb :: IO ()-demoWeb = do-  let demoPort = 8080-  res <--    runM . runThrow $ initAppState (defaultAppOpts {userScenario = demoScenario})-  case res of-    Left err -> T.putStrLn (prettyText @SystemFailure err)-    Right s -> do-      appStateRef <- newIORef s-      chan <- newBChan 5-      webMain-        Nothing-        demoPort-        (mkReadonly appStateRef)-        chan- where-  demoScenario = Just "./data/scenarios/Testing/475-wait-one.yaml"---- | If available for the terminal emulator, enable bracketed paste mode.-enablePasteMode :: EventM n s ()-enablePasteMode = do-  vty <- getVtyHandle-  let output = V.outputIface vty-  when (V.supportsMode output V.BracketedPaste) $-    liftIO $-      V.setMode output V.BracketedPaste True
app/doc/Main.hs view
@@ -19,6 +19,7 @@       , command "editors" (info (EditorKeywords <$> editor <**> helper) $ progDesc "Output editor keywords")       , command "keys" (info (pure SpecialKeyNames) $ progDesc "Output list of recognized special key names")       , command "cheatsheet" (info (CheatSheet <$> address <*> cheatsheet <**> helper) $ progDesc "Output nice Wiki tables")+      , command "commands" (info (pure CommandsData <**> helper) $ progDesc "Output JSON data for commands matrix")       , command "pedagogy" (info (pure TutorialCoverage) $ progDesc "Output tutorial coverage")       ]  where
+ app/game/Main.hs view
@@ -0,0 +1,231 @@+{-# LANGUAGE ApplicativeDo #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TemplateHaskell #-}++-- |+-- SPDX-License-Identifier: BSD-3-Clause+module Main (main) where++import Control.Monad (when)+import Data.Foldable qualified+import Data.List.Extra (enumerate)+import Data.Set qualified as Set+import Data.Text.IO qualified as T+import GitHash (GitInfo, giBranch, giHash, tGitInfoCwdTry)+import Options.Applicative+import Options.Applicative.Help hiding (color, fullDesc)+import Swarm.App (appMain)+import Swarm.Language.Format+import Swarm.Language.LSP (lspMain)+import Swarm.Language.Parser.Core (LanguageVersion (..))+import Swarm.ResourceLoading (getSwarmConfigIniFile)+import Swarm.TUI.Model (AppOpts (..), ColorMode (..))+import Swarm.TUI.Model.DebugOption+import Swarm.TUI.Model.KeyBindings (KeybindingPrint (..), showKeybindings)+import Swarm.TUI.Model.UI (defaultInitLgTicksPerSecond)+import Swarm.Version+import Swarm.Web (defaultPort)+import System.IO (hPrint, stderr)+import Text.Read (readMaybe)++gitInfo :: Maybe GitInfo+gitInfo = either (const Nothing) Just $$tGitInfoCwdTry++commitInfo :: String+commitInfo = case gitInfo of+  Nothing -> ""+  Just git -> " (" <> giBranch git <> "@" <> take 10 (giHash git) <> ")"++data CLI+  = Run AppOpts+  | -- | Print list of bindings, optionally initializing the INI configuration file.+    ListKeybinding Bool KeybindingPrint+  | Format FormatConfig+  | LSP+  | Version++cliParser :: Parser CLI+cliParser =+  subparser+    ( mconcat+        [ command "run" (info (Run <$> appOpts <**> helper) (progDesc "Run the Swarm game (default)"))+        , command "format" (info (Format <$> parseFormat) (progDesc "Format a file"))+        , command "lsp" (info (pure LSP) (progDesc "Start the LSP"))+        , command "version" (info (pure Version) (progDesc "Get current and upstream version."))+        , command "keybindings" (info (ListKeybinding <$> initKeybindingConfig <*> printKeyMode <**> helper) (progDesc "List the keybindings"))+        ]+    )+    <|> Run <$> appOpts+ where+  appOpts :: Parser AppOpts+  appOpts = do+    let repoGitInfo = gitInfo+    userSeed <- seed+    userScenario <- scenario+    scriptToRun <- run+    pausedAtStart <- paused+    autoPlay <- autoplay+    autoShowObjectives <- not <$> hideGoal+    speed <- speedFactor+    debugOptions <- debug+    cheatMode <- cheat+    colorMode <- color+    userWebPort <- webPort+    -- ApplicativeDo does not give Monad powers, so cheat is added here+    return $ addToDebug cheatMode $ AppOpts {..}++  addToDebug :: Set.Set DebugOption -> AppOpts -> AppOpts+  addToDebug cheatMode ao = ao {debugOptions = cheatMode `Set.union` debugOptions ao}++  input :: Parser FormatInput+  input =+    flag' Stdin (long "stdin" <> help "Read code from stdin")+      <|> (InputFile <$> strArgument (metavar "FILE"))++  output :: Parser FormatOutput+  output =+    flag Stdout Stdout (long "stdout" <> help "Write formatted code to stdout (default)")+      <|> (OutputFile <$> strOption (long "output" <> short 'o' <> metavar "FILE" <> help "Write formatted code to an output file"))+      <|> flag' Inplace (long "inplace" <> short 'i' <> help "Format file in place")++  widthOpt :: Parser FormatWidth+  widthOpt = option auto (long "width" <> metavar "COLUMNS" <> help "Use layout with maximum width")++  langVer :: Parser LanguageVersion+  langVer = flag SwarmLangLatest SwarmLang0_6 (long "v0.6" <> help "Read (& convert) code from Swarm version 0.6")++  printKeyMode :: Parser KeybindingPrint+  printKeyMode =+    flag' IniPrint (long "ini" <> help "Print in INI format")+      <|> flag' MarkdownPrint (long "markdown" <> help "Print in Markdown table format")+      <|> pure TextPrint++  initKeybindingConfig :: Parser Bool+  initKeybindingConfig = switch (short 'i' <> long "init" <> help "Initialise the keybindings configuration file")++  parseFormat :: Parser FormatConfig+  parseFormat = FormatConfig <$> input <*> output <*> optional widthOpt <*> langVer <**> helper++  seed :: Parser (Maybe Int)+  seed = optional $ option auto (long "seed" <> short 's' <> metavar "INT" <> help "Seed to use for world generation")++  webPort :: Parser (Maybe Int)+  webPort =+    optional $+      option+        auto+        ( long "web"+            <> metavar "PORT"+            <> help ("Set the web service port (or disable it with 0). Default to " <> show defaultPort <> ".")+        )+  scenario :: Parser (Maybe String)+  scenario = optional $ strOption (long "scenario" <> short 'i' <> metavar "FILE" <> help "Name of an input scenario to load")+  run :: Parser (Maybe String)+  run = optional $ strOption (long "run" <> short 'r' <> metavar "FILE" <> help "Run the commands in a file at startup")+  paused :: Parser Bool+  paused = switch (long "paused" <> short 'p' <> help "Pause the game at start.")+  autoplay :: Parser Bool+  autoplay = switch (long "autoplay" <> short 'a' <> help "Automatically run the solution defined in the scenario, if there is one. Mutually exclusive with --run.")+  hideGoal :: Parser Bool+  hideGoal = switch (long "hide-goal" <> help "Do not show goal modal window that pauses the game.")+  speedFactor :: Parser Int+  speedFactor = option auto (long "speed" <> short 'm' <> metavar "N" <> value defaultInitLgTicksPerSecond <> help speedFactorHelp)+  speedFactorHelp =+    unwords+      [ "Initial game speed."+      , "Counted as 2^N ticks per second, default is"+      , show defaultInitLgTicksPerSecond+      , "meaning"+      , show $ 2 ** fromIntegral @Int @Double defaultInitLgTicksPerSecond+      , "t/s."+      , "(Negative values are allowed, e.g. -3 means 1 tick per 8 sec.)"+      ]++  debug :: Parser (Set.Set DebugOption)+  debug = Set.unions <$> many debugOption+  debugOption :: Parser (Set.Set DebugOption)+  debugOption =+    option+      debugOptionList+      ( long "debug"+          <> short 'd'+          <> metavar "OPTS"+          <> hidden+          <> helpDoc debugOptionHelp+          <> completeWith debugCompletions+      )+  debugCompletions = "all" : map debugOptionName enumerate+  debugOptionList :: ReadM (Set.Set DebugOption)+  debugOptionList = eitherReader $ \case+    "all" -> pure $ Set.fromAscList enumerate+    opts -> Set.fromList <$> readDebugOptionList opts+  debugOptionHelp :: Maybe Doc+  debugOptionHelp =+    Just . nest 2 . vsep $+      "Use 'all' or a comma separated list of options:"+        : [ fillBreak 20 ("*" <+> pretty name) <+> pretty desc+          | o <- enumerate+          , let name = debugOptionName o+          , let desc = debugOptionDescription o+          ]+  cheat :: Parser (Set.Set DebugOption)+  cheat = flag mempty (Set.singleton ToggleCreative) (long "cheat" <> short 'x' <> helpDoc (Just cheatHelp))+  cheatHelp =+    "Enable cheat mode."+      <+> pretty ("This is an alias for --debug=" <> debugOptionName ToggleCreative)++  color :: Parser (Maybe ColorMode)+  color = optional $ option colorModeParser (long "color" <> short 'c' <> metavar "MODE" <> help "Use none/8/16/full color mode.")+  colorModeParser =+    Data.Foldable.asum+      [ ColorMode8 <$ text "8"+      , ColorMode16 <$ text "16"+      , ColorMode240 <$> maybeReader (\case ('2' : '4' : '0' : '_' : w) -> readMaybe w; _ -> Nothing)+      , FullColor <$ text "full"+      , NoColor <$ text "none"+      ]+  text t = maybeReader (\x -> if x == t then Just x else Nothing)++cliInfo :: ParserInfo CLI+cliInfo =+  info+    (cliParser <**> helper)+    ( header ("Swarm game - " <> version <> commitInfo)+        <> progDesc "To play the game simply run without any command."+        <> fullDesc+    )++showVersion :: IO ()+showVersion = do+  putStrLn $ "Swarm game - " <> version <> commitInfo+  up <- getNewerReleaseVersion gitInfo+  either (hPrint stderr) (putStrLn . ("New upstream release: " <>)) up++printKeybindings :: Bool -> KeybindingPrint -> IO ()+printKeybindings initialize p = do+  kb <- showKeybindings p+  T.putStrLn kb+  (iniExists, ini) <- getSwarmConfigIniFile initialize+  when initialize $ do+    kbi <- showKeybindings IniPrint+    T.writeFile ini kbi+  let iniState+        | iniExists && initialize = "has been updated"+        | iniExists = "is"+        | initialize = "has been created"+        | otherwise = "can be created (--init)"+  putStrLn $ replicate 80 '-'+  putStrLn $ "The configuration file " <> iniState <> " at:"+  putStrLn ini++main :: IO ()+main = do+  cli <- execParser cliInfo+  case cli of+    Run opts -> appMain opts+    ListKeybinding initialize p -> printKeybindings initialize p+    Format cfg -> formatSwarmIO cfg+    LSP -> lspMain+    Version -> showVersion
+ app/game/Swarm/App.hs view
@@ -0,0 +1,186 @@+{-# LANGUAGE NumericUnderscores #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-}++{- HLINT ignore "Use underscore" -}++-- |+-- SPDX-License-Identifier: BSD-3-Clause+-- Description: Application entry point+--+-- Main entry point for the Swarm application.+module Swarm.App (+  app,+  appMain,+  EventHandler,++  -- * Demo web+  demoWeb,+) where++import Brick+import Brick.BChan+import Control.Carrier.Lift (runM)+import Control.Carrier.Throw.Either (runThrow)+import Control.Concurrent (forkIO, threadDelay)+import Control.Lens (view, (%~), (?~))+import Control.Monad (forever, void, when)+import Control.Monad.IO.Class (liftIO)+import Data.IORef (IORef, modifyIORef, newIORef, readIORef, writeIORef)+import Data.Text qualified as T+import Data.Text.IO qualified as T+import GitHash (GitInfo)+import Graphics.Vty qualified as V+import Graphics.Vty.CrossPlatform qualified as V+import Swarm.Failure (SystemFailure)+import Swarm.Game.State.Runtime+import Swarm.Log (LogSource (SystemLog), Severity (..))+import Swarm.Pretty (prettyText)+import Swarm.TUI.Controller+import Swarm.TUI.Model+import Swarm.TUI.Model.StateUpdate+import Swarm.TUI.Model.UI (uiAttrMap)+import Swarm.TUI.View+import Swarm.Version (getNewerReleaseVersion)+import Swarm.Web+import System.Exit+import System.IO (stderr)++type EventHandler = BrickEvent Name AppEvent -> EventM Name AppState ()++-- | The configuration of the Swarm app which we pass to the @brick@+--   library.+app :: EventHandler -> App AppState AppEvent Name+app eventHandler =+  App+    { appDraw = drawUI+    , appChooseCursor = chooseCursor+    , appHandleEvent = eventHandler+    , appStartEvent = pure ()+    , appAttrMap = view $ uiState . uiAttrMap+    }++-- | The main @IO@ computation which initializes the state, sets up+--   some communication channels, and runs the UI.+appMain :: AppOpts -> IO ()+appMain opts = do+  chan <- createChannel+  res <- runM . runThrow $ initAppState opts (Just chan)+  case res of+    Left err -> do+      T.hPutStrLn stderr (prettyText @SystemFailure err)+      exitFailure+    Right s -> do+      -- NOTE: The state reference is read-only by the web service;+      -- the brick app has the real state and updates the reference.+      appStateRef <- newIORef s+      sendFrameEvents chan+      sendUpstreamVersion chan (repoGitInfo opts)+      -- Start web service+      eport <-+        Swarm.Web.startWebThread+          (userWebPort opts)+          (readIORef appStateRef)+          (writeBChan chan)++      modifyIORef appStateRef $ logWebPort eport++      -- Setup virtual terminal+      vty <- buildVty $ colorMode opts+      modifyIORef appStateRef $ logColorMode vty++      -- Run the app.+      void $+        readIORef appStateRef+          >>= customMain+            vty+            (buildVty $ colorMode opts)+            (Just chan)+            (app $ handleEventAndUpdateWeb appStateRef)++-- | A demo program to run the web service directly, without the terminal application.+--   This is useful to live update the code using @ghcid -W --test "Swarm.App.demoWeb"@.+demoWeb :: IO ()+demoWeb = do+  let demoPort = 8080+  chan <- createChannel+  res <-+    runM . runThrow $ initAppState (defaultAppOpts {userScenario = demoScenario}) (Just chan)+  case res of+    Left err -> T.putStrLn (prettyText @SystemFailure err)+    Right s -> do+      webMain+        Nothing+        demoPort+        (pure s)+        (writeBChan chan)+ where+  demoScenario = Just "./data/scenarios/Testing/475-wait-one.yaml"++-- | Create a channel for app events.+--+-- 5 is the size of the bounded channel; when it gets that big,+-- any writes to it will block.  Probably 1 would work fine,+-- though it seems like it could be good to have a bit of buffer+-- just so the app never has to wait for the thread to wake up+-- and do another write.+--+-- Note that there are occasionally other events (web, version)+-- so this buffer is big enough for them too.+createChannel :: IO (BChan AppEvent)+createChannel = newBChan 5++-- | Send Frame events as at a reasonable rate for 30 fps.+--+-- The game is responsible for figuring out how many steps to take+-- each frame to achieve the desired speed, regardless of the+-- frame rate.  Note that if the game cannot keep up with 30+-- fps, it's not a problem: the channel will fill up and this+-- thread will block.  So the force of the threadDelay is just+-- to set a *maximum* possible frame rate.+sendFrameEvents :: BChan AppEvent -> IO ()+sendFrameEvents chan = void . forkIO . forever $ do+  writeBChan chan Frame+  threadDelay 33_333 -- cap maximum framerate at 30 FPS++-- | Get newer upstream version and send event to channel.+sendUpstreamVersion :: BChan AppEvent -> Maybe GitInfo -> IO ()+sendUpstreamVersion chan gitInfo = void . forkIO $ do+  upRel <- getNewerReleaseVersion gitInfo+  writeBChan chan (UpstreamVersion upRel)++-- | Log and save the web port or log web startup failure.+logWebPort :: Either String Int -> AppState -> AppState+logWebPort eport =+  runtimeState %~ case eport of+    Right p -> (webPort ?~ p) . (eventLog %~ logP p)+    Left e -> eventLog %~ logE e+ where+  logP p = logEvent SystemLog Info "Web API" ("started on :" <> T.pack (show p))+  logE e = logEvent SystemLog Error "Web API" (T.pack e)++-- | Build VTY with preffered color mode and bracketed paste mode if available.+--+-- Note that this will also run whenever the event loop needs to reinitialize+-- the terminal, e.g. on resume after suspension. See 'customMain'.+buildVty :: Maybe ColorMode -> IO V.Vty+buildVty cm = do+  vty <- V.mkVty V.defaultConfig {V.configPreferredColorMode = cm}+  let output = V.outputIface vty+  V.setMode output V.Mouse True+  when (V.supportsMode output V.BracketedPaste) $+    V.setMode output V.BracketedPaste True+  return vty++-- | Log the VTY color mode to system log.+logColorMode :: V.Vty -> AppState -> AppState+logColorMode vty = runtimeState . eventLog %~ logEvent SystemLog Info "Graphics" ("Color mode: " <> T.pack (show cm))+ where+  cm = V.outputColorMode $ V.outputIface vty++-- | Update the reference after every event.+handleEventAndUpdateWeb :: IORef AppState -> BrickEvent Name AppEvent -> EventM Name AppState ()+handleEventAndUpdateWeb appStateRef e = do+  handleEvent e+  curSt <- get+  liftIO $ writeIORef appStateRef curSt
+ app/game/Swarm/Version.hs view
@@ -0,0 +1,185 @@+{-# LANGUAGE OverloadedStrings #-}++-- |+-- SPDX-License-Identifier: BSD-3-Clause+--+-- Query current and upstream Swarm version.+module Swarm.Version (+  -- * PVP version+  isSwarmReleaseTag,+  version,++  -- ** Upstream release+  tagToVersion,+  upstreamReleaseVersion,+  getNewerReleaseVersion,+  NewReleaseFailure (..),+) where++import Control.Exception (catch, displayException)+import Data.Aeson (Array, Value (..), (.:))+import Data.Bifunctor (first)+import Data.ByteString qualified as BS+import Data.ByteString.Lazy qualified as BSL+import Data.Char (isDigit)+import Data.Either (lefts, rights)+import Data.Foldable (toList)+import Data.Maybe (listToMaybe)+import Data.Text (Text)+import Data.Text qualified as T+import Data.Version (Version (..), parseVersion, showVersion)+import Data.Yaml (ParseException, Parser, decodeEither', parseEither)+import GitHash (GitInfo, giBranch)+import Network.HTTP.Client (+  HttpException,+  Request (requestHeaders),+  Response (responseBody),+  httpLbs,+  newManager,+  parseRequest,+ )+import Network.HTTP.Client.TLS (tlsManagerSettings)+import Network.HTTP.Types (hUserAgent)+import Paths_swarm qualified+import Swarm.Log+import Swarm.Util (failT, quote)+import Text.ParserCombinators.ReadP (readP_to_S)++-- $setup+-- >>> import Data.Bifunctor (first)+-- >>> import Data.Version (Version (..), parseVersion)+-- >>> import Text.ParserCombinators.ReadP (readP_to_S)++-- | Check that the tag follows the PVP versioning policy.+--+-- Note that this filters out VS Code plugin releases.+isSwarmReleaseTag :: String -> Bool+isSwarmReleaseTag = all (\c -> isDigit c || c == '.')++version :: String+version =+  let v = showVersion Paths_swarm.version+   in if v == "0.0.0.1" then "pre-alpha version" else v++-- | Get the current upstream release version if any.+upstreamReleaseVersion :: IO (Either NewReleaseFailure String)+upstreamReleaseVersion =+  catch+    (either parseFailure getRelease . decodeResp <$> sendRequest)+    (return . Left . queryFailure)+ where+  -- ------------------------------+  -- send request to GitHub API+  sendRequest :: IO (Response BSL.ByteString)+  sendRequest = do+    manager <- newManager tlsManagerSettings+    request <- parseRequest "https://api.github.com/repos/swarm-game/swarm/releases"+    httpLbs+      request {requestHeaders = [(hUserAgent, "swarm-game/swarm-swarmversion")]}+      manager+  -- ------------------------------+  -- get the latest actual release+  getRelease :: Array -> Either NewReleaseFailure String+  getRelease rs =+    let ts = parseReleases rs+        maybeRel = listToMaybe $ rights ts+     in case maybeRel of+          Nothing -> Left $ NoMainUpstreamRelease (lefts ts)+          Just rel -> Right rel+  -- ------------------------------+  -- pretty print failures+  parseFailure :: ParseException -> Either NewReleaseFailure String+  parseFailure e = Left . FailedReleaseQuery $ "Failure during response parsing: " <> displayException e+  queryFailure :: HttpException -> NewReleaseFailure+  queryFailure e = FailedReleaseQuery $ "Failure requesting GitHub releases: " <> displayException e+  -- ------------------------------+  -- parsing helpers+  decodeResp :: Response BSL.ByteString -> Either ParseException Array+  decodeResp resp = decodeEither' (BS.pack . BSL.unpack $ responseBody resp)+  parseReleases :: Array -> [Either String String]+  parseReleases = map (parseEither parseRelease) . toList++parseRelease :: Value -> Parser String+parseRelease = \case+  Object o -> do+    pre <- o .: "prerelease"+    if pre+      then fail "Not a real release!"+      else do+        t <- o .: "tag_name"+        if isSwarmReleaseTag t+          then return t+          else failT ["The release", quote $ T.pack t, "is not main Swarm release!"]+  _otherValue -> fail "The JSON release is not an Object!"++data NewReleaseFailure where+  FailedReleaseQuery :: String -> NewReleaseFailure+  NoMainUpstreamRelease :: [String] -> NewReleaseFailure+  OnDevelopmentBranch :: String -> NewReleaseFailure+  OldUpstreamRelease :: Version -> Version -> NewReleaseFailure++instance Show NewReleaseFailure where+  show = \case+    FailedReleaseQuery e -> "Failed to query upstream release: " <> e+    NoMainUpstreamRelease fs ->+      "No upstream releases found."+        <> if null fs+          then ""+          else " Rejected:\n" <> unlines (zipWith ((<>) . show @Int) [1 ..] fs)+    OnDevelopmentBranch br -> "Currently on development branch '" <> br <> "', skipping release query."+    OldUpstreamRelease up my ->+      "Upstream release '"+        <> showVersion up+        <> "' is not newer than mine ('"+        <> showVersion my+        <> "')."++-- | Read Swarm tag as Version.+--+-- Swarm tags follow the PVP versioning scheme, so comparing them makes sense.+--+-- >>> map (first versionBranch) $ readP_to_S parseVersion "0.1.0.0"+-- [([0],".1.0.0"),([0,1],".0.0"),([0,1,0],".0"),([0,1,0,0],"")]+-- >>> Version [0,0,0,1] [] < tagToVersion "0.1.0.0"+-- True+tagToVersion :: String -> Version+tagToVersion = fst . last . readP_to_S parseVersion++-- | Drop trailing zeros from versions so that we can compare them.+normalize :: Version -> Version+normalize (Version ns tags) = Version (dropTrailing0 ns) tags+ where+  dropTrailing0 = reverse . dropWhile (== 0) . reverse++-- | Get a newer upstream release version.+--+-- This function can fail if the current branch is not main,+-- if there is no Internet connection or no newer release.+getNewerReleaseVersion :: Maybe GitInfo -> IO (Either (Severity, Text) String)+getNewerReleaseVersion mgi = first errToPair <$> getVer+ where+  myVer :: Version+  myVer = Paths_swarm.version+  getVer :: IO (Either NewReleaseFailure String)+  getVer =+    case mgi of+      -- when using cabal install, the git info is unavailable, which is of no interest to players+      Nothing -> (>>= getUpVer) <$> upstreamReleaseVersion+      Just gi ->+        if giBranch gi /= "main"+          then return . Left . OnDevelopmentBranch $ giBranch gi+          else (>>= getUpVer) <$> upstreamReleaseVersion+  getUpVer :: String -> Either NewReleaseFailure String+  getUpVer upTag =+    let upVer = tagToVersion upTag+     in if normalize myVer >= normalize upVer+          then Left $ OldUpstreamRelease upVer myVer+          else Right upTag+  errToPair :: NewReleaseFailure -> (Severity, Text)+  errToPair e = (toSev e, T.pack $ show e)+  toSev :: NewReleaseFailure -> Severity+  toSev = \case+    FailedReleaseQuery {} -> Error+    NoMainUpstreamRelease {} -> Warning+    OnDevelopmentBranch {} -> Info+    OldUpstreamRelease {} -> Warning
app/scene/Main.hs view
@@ -6,7 +6,7 @@  import Options.Applicative import Swarm.Game.Scenario.Topography.Area (AreaDimensions (..))-import Swarm.Game.World.Render (FailureMode (..), OuputFormat (..), RenderOpts (..), doRenderCmd)+import Swarm.Game.World.Render (FailureMode (..), OuputFormat (..), RenderComputationContext (..), RenderOpts (..), doRenderCmd)  data CLI   = RenderMap FilePath RenderOpts@@ -20,12 +20,16 @@       <$> option auto (metavar "WIDTH" <> short 'w' <> long "width" <> help "width of source grid")       <*> option auto (metavar "HEIGHT" <> short 'h' <> long "height" <> help "height of source grid") +  renderComputationOpts =+    RenderComputationContext+      <$> seed+      <*> optional sizeOpts+   subOpts =     RenderOpts-      <$> seed+      <$> renderComputationOpts       <*> flag ConsoleText PngImage (long "png" <> help "Render to PNG")       <*> option str (long "dest" <> short 'd' <> value "output.png" <> help "Output filepath")-      <*> optional sizeOpts       <*> flag Terminate RenderBlankImage (long "fail-blank" <> short 'b' <> help "Render blank image upon failure")    seed :: Parser (Maybe Int)
data/entities.yaml view
@@ -69,7 +69,7 @@     char: '■'   description:     - A flat material made of pressed and dried wood fibers, used as a surface on which to inscribe symbols.-  properties: [pickable, combustible]+  properties: [pickable, combustible, printable]   combustion:     ignition: 0.5     duration: [10, 20]@@ -103,7 +103,7 @@   description:     - A medium-sized rock... that looks a little different. It seems to react to iron and surprisingly also to naturally growing bits.   properties: [pickable]-  capabilities: [negation]+  capabilities: [not] - name: beaglepuss   display:     attr: rubber@@ -330,6 +330,49 @@     ignition: 0.1     duration: [20, 40]     product: ash+- name: wheat+  display:+    char: 'w'+    attr: gold+  description:+    - Edible grain+  properties: [pickable, growable]+  growth:+    duration: [20, 30]+    spread:+      radius: 2+      density: 0.3+  biomes: [dirt, clay]+- name: millstone+  display:+    char: 'm'+    attr: rock+  description:+    - Grinds grain+  properties: [pickable]+- name: flour+  display:+    char: 'f'+    attr: snow+  description:+    - Edible, ground wheat+  properties: [pickable]+- name: parsley+  display:+    attr: plant+    char: 'p'+  description:+    - A fast-growing plant with a pungent aroma, often found growing near rocks.+    - |+      When equipped as a device, parsley enables the `read` command, which can be used to turn text into values:+      ```+      read : Type -> Text -> a+      ```+      If the given `Text`{=type} represents a value of the given `Type`{=type} (written using `@`{=snippet} syntax), the value will be returned; otherwise, an exception is thrown.  For example, `(read @Int "3") == 3`, but `read @Int "hello"` crashes.+    - Note that `read`, unlike `format`, is unable to deal with function, delay, or command types.+  properties: [pickable, growable]+  capabilities: [read]+  growth: [10, 100] - name: linotype   display:     attr: silver@@ -361,7 +404,7 @@       in "Number of widgets: " ++ format numWidgets       ```   properties: [pickable]-  capabilities: [concat]+  capabilities: ["++"] - name: caliper   display:     attr: silver@@ -374,7 +417,7 @@       ```       computes the number of characters in a `Text`{=type} value.   properties: [pickable]-  capabilities: [charcount]+  capabilities: [chars] - name: wedge   display:     attr: silver@@ -416,7 +459,7 @@       `split : Int -> Text -> Text * Text` splits a `Text`{=type} value into       two pieces, one before the given index and one after.   properties: [pickable]-  capabilities: [format, concat, charcount, split]+  capabilities: [format, '++', chars, split] - name: decoder ring   display:     attr: silver@@ -433,7 +476,7 @@       `toChar : Int -> Text` creates a singleton (length-1) `Text`{=type}       value containing a character with the given numeric code.   properties: [pickable]-  capabilities: [code]+  capabilities: [charat, tochar] - name: lambda   display:     attr: flower@@ -462,14 +505,14 @@     char: ' '   description:     - Liquid dihydrogen monoxide, which seems to be plentiful on this planet.-  properties: [pickable, infinite, liquid]+  properties: [pickable, infinite, liquid, evanescent] - name: wavy water   display:     attr: water     char: '~'   description:     - A wavy section of water.  The same as normal water, but with more waves.-  properties: [pickable, infinite, liquid]+  properties: [pickable, infinite, liquid, evanescent]   yields: water - name: boat   display:@@ -580,15 +623,15 @@     attr: blue     char: 'B'   description:-    - This enables the `structure` and `floorplan` commands to locate and analyze structures placed in the world.+    - This enables the `structures` and `floorplan` commands to locate and analyze structures placed in the world.     - |-      `structure : Text -> Int -> Cmd (Unit + (Int * (Int * Int)))`-    - Gets the x, y coordinates of the southwest corner of a constructed structure, by name and index.+      `structures : Text -> Cmd (rec l. Unit + (Int * Int) * l)`+    - Gets the x, y coordinates of the southwest corner of every constructed structure with a given name.     - |       `floorplan : Text -> Cmd (Int * Int)`     - Gets the dimensions of a structure template.   properties: [pickable]-  capabilities: [structure]+  capabilities: [structures, floorplan] - name: drill bit   display:     attr: entity@@ -635,76 +678,13 @@ ############################################################ ### Utility ################################################ ############################################################-- name: upper left corner+- name: wall   display:+    char: '+'     attr: entity-    char: '┌'   description:-    - Upper left corner.-  properties: [unwalkable, known]-- name: upper right corner-  display:-    attr: entity-    char: '┐'-  description:-    - An upper right corner wall.-  properties: [unwalkable, known]-- name: lower left corner-  display:-    attr: entity-    char: '└'-  description:-    - A lower left corner wall.-  properties: [unwalkable, known]-- name: lower right corner-  display:-    attr: entity-    char: '┘'-  description:-    - A lower right corner wall.-  properties: [unwalkable, known]-- name: down and horizontal wall-  display:-    attr: entity-    char: '┬'-  description:-    - A down and horizontal wall.-  properties: [unwalkable, known]-- name: up and horizontal wall-  display:-    attr: entity-    char: '┴'-  description:-    - A up and horizontal wall.-  properties: [unwalkable, known]-- name: left and vertical wall-  display:-    attr: entity-    char: '┤'-  description:-    - A left and vertical wall.-  properties: [unwalkable, known]-- name: right and vertical wall-  display:-    attr: entity-    char: '├'-  description:-    - A right and vertical wall.-  properties: [unwalkable, known]-- name: horizontal wall-  display:-    attr: entity-    char: '─'-  description:-    - A horizontal wall.-  properties: [unwalkable, known]-- name: vertical wall-  display:-    attr: entity-    char: '│'-  description:-    - A vertical wall.-  properties: [unwalkable, known]+    - A wall+  properties: [unwalkable, known, boundary] ############################################################ ### Devices ################################################ ############################################################@@ -743,7 +723,7 @@     char: '%'   description:     - Tank treads work like treads, but are large enough to move even heavy robots around.-  capabilities: [move, turn, moveheavy]+  capabilities: [move, turn, move heavy robot]   properties: [pickable] - name: tape drive   display:@@ -791,7 +771,7 @@     char: 'B'   description:     - Allows one to `scout` for other robots-  capabilities: [recondir]+  capabilities: [scout]   properties: [pickable] - name: welder   display:@@ -857,8 +837,9 @@     attr: device     char: 'Д'   description:-    - A typewriter is used to inscribe symbols on paper, thus reifying pure, platonic information into a physical form.+    - A typewriter is used to inscribe symbols on `paper`{=entity}, thus reifying pure, platonic information into a physical form.   properties: [pickable]+  capabilities: [print, erase] - name: 3D printer   display:     attr: device@@ -921,7 +902,7 @@       if (x > 3) {move} {turn right; move}       ```   properties: [pickable]-  capabilities: [cond]+  capabilities: [if, '&&', '||'] - name: detonator   display:     attr: fire@@ -942,11 +923,20 @@     attr: device     char: '$'   description:-    - "With a scanner device, robots can use the `scan` command to learn about their surroundings.  Simply give `scan` a direction in which to scan, and information about the scanned item (if any) will be added to the robot's inventory."-    - "A scanner also enables `blocked : Cmd Bool`, which returns a boolean value indicating whether the robot's path is blocked (i.e. whether executing a `move` command would fail); `ishere : Text -> Cmd Bool` for checking whether the current cell contains a particular entity; and `isempty : Cmd Bool` for checking whether the current cell is empty of entities. Note that `ishere` and `isempty` do not detect robots, only entities."-    - "Finally, robots can use the `upload` command to copy their accumulated knowledge to another nearby robot; for example, `upload base`."+    - |+      With a scanner device, robots can use the `scan` command to learn about their surroundings.+      Simply give `scan` a direction in which to scan, and information about the scanned item (if any)+      will be added to the robot's inventory.+    - |+      A scanner also enables `blocked : Cmd Bool`, which returns a boolean value indicating whether the robot's path is blocked+      (i.e. whether executing a `move` command would fail); `ishere : Text -> Cmd Bool` for checking whether the current cell+      contains a particular entity; and `isempty : Cmd Bool` for checking whether the current cell is empty of entities.+      Note that `ishere` and `isempty` do not detect robots, only entities."+    - |+      Finally, robots can use the `upload` command to copy their accumulated knowledge to another nearby robot;+      for example, `upload base`."   properties: [pickable]-  capabilities: [scan, sensefront, sensehere]+  capabilities: [scan, blocked, ishere, isempty, upload] - name: olfactometer   display:     char: 'N'@@ -955,7 +945,7 @@     - |       `sniff : Text -> Cmd Int` returns the distance to the nearest specified entity.   properties: [pickable]-  capabilities: [detectdistance]+  capabilities: [sniff] - name: flash memory   display:     attr: device@@ -975,7 +965,7 @@     - "A mirror enables the `whoami` command, which returns the robot's name as a string."     - "It also enables the special `self` variable, which gives a robot a reference to itself."   properties: [pickable]-  capabilities: [whoami]+  capabilities: [whoami, self] - name: logger   display:     attr: device@@ -1019,7 +1009,7 @@   description:     - "A calculator allows a robot to do basic arithmetic calculations: addition, subtraction, multiplication, division, and exponentiation."   properties: [pickable]-  capabilities: [arith]+  capabilities: ['+', '-', neg, '*', '/', '^'] - name: ADT calculator   display:     attr: device@@ -1040,8 +1030,8 @@       if `t`{=type} is a type with three elements, then there are 2 * 3 = 6       different pairs containing a `Bool`{=type} and a `t`{=type}, that is, 6 elements       of type `Bool * t`{=type}.  For working with products of types, the ADT-      calculator enables pair syntax `(1, "Hi!")` as well as the projection-      functions `fst : a * b -> a` and `snd : a * b -> b`.+      calculator enables pair syntax `(1, "Hi!")` as well as the pair elimination+      function `match : a * b -> (a -> b -> c) -> c`.     - |       The sum of two types is a type with two options; for example, a       value of type `Bool + t`{=type} is either a `Bool`{=type} value or a `t`{=type} value,@@ -1052,7 +1042,7 @@       example, `case (inl 3) (\x. 2*x) (\y. 3*y) == 6`, and `case (inr       3) (\x. 2*x) (\y. 3*y) == 9`.   properties: [pickable]-  capabilities: [arith, sum, prod]+  capabilities: ['+', '-', neg, '*', '/', '^', sum, prod] - name: hyperloop   display:     attr: device@@ -1067,7 +1057,7 @@       `t = T(t)`{=snippet}. For exmple, `rec l. Unit + Int * l`{=type} is       the type of lists of integers.   properties: [pickable]-  capabilities: [arith, sum, prod, rectype]+  capabilities: ['+', '-', neg, '*', '/', '^', sum, prod, rectype] - name: compass   display:     attr: device@@ -1085,7 +1075,7 @@     - |       `d <- heading; turn east; move; turn d`   properties: [pickable]-  capabilities: [orient]+  capabilities: [orient, heading] - name: clock   display:     attr: device@@ -1097,7 +1087,7 @@     - |       `wait : Int -> Cmd Unit` causes a robot to sleep for a specified amount of time (measured in game ticks).   properties: [pickable]-  capabilities: [timeabs, timerel]+  capabilities: [time, wait] - name: hourglass   display:     attr: device@@ -1107,7 +1097,7 @@     - |       `wait : Int -> Cmd Unit` causes a robot to sleep for a specified amount of time (measured in game ticks).   properties: [pickable]-  capabilities: [timerel]+  capabilities: [wait] - name: rolex   display:     char: R@@ -1118,7 +1108,7 @@       `watch : Dir -> Cmd Unit` will mark an adjacent (in the specified direction) location of interest to monitor for placement or removal of items.       A subsequent call to `wait` will be interrupted upon a change to the location.   properties: [pickable]-  capabilities: [timerel, wakeself]+  capabilities: [time, wait, watch] - name: comparator   display:     attr: device@@ -1127,7 +1117,7 @@     - "A comparator allows comparing two values to see whether the first is less, equal, or greater than the second."     - "Valid comparison operators are <, <=, >, >=, ==, and !=."   properties: [pickable]-  capabilities: [compare]+  capabilities: ['<', '<=', '>', '>=', '==', '!='] - name: I/O cable   display:     attr: device@@ -1143,14 +1133,14 @@     - "A rubber band can tie multiple commands together so that other robots can't execute commands in between them.  It can be used via the `atomic` command. For example, suppose robot A executes the following code:"     - |       ```-      b <- ishere "rock"; if b {grab; return ()} {}+      b <- ishere "rock"; if b {grab; pure ()} {}       ```     - "This seems like a safe way to execute `grab` only when there is a rock to grab.  However, it is actually possible for the `grab` to fail, if some other robot B snatches the rock right after robot A sensed it and before robot A got around to grabbing it on the next game tick."     - "This will make robot A very sad and it will crash."     - "To prevent this situation, robot A can wrap the commands in `atomic`, like so:"     - |       ```-      atomic (b <- ishere "rock"; if b {grab; return ()} {})+      atomic (b <- ishere "rock"; if b {grab; pure ()} {})       ```   properties: [pickable]   capabilities: [atomic]@@ -1186,7 +1176,17 @@       `meetAll : Cmd (rec l. Unit + Actor * l)` returns a list of       all the nearby actors other than oneself.   properties: [pickable]-  capabilities: [meet]+  capabilities: [meet, meetAll]+- name: atlas+  display:+    attr: device+    char: 'a'+  description:+    - |+      An atlas enables the `waypoints` command: `waypoints : Text -> (rec l. Unit + (Int * Int) * l)`.+      This gets the x, y coordinates of the every waypoint with a given name.+  properties: [pickable]+  capabilities: [waypoints] - name: GPS receiver   display:     attr: device@@ -1197,7 +1197,7 @@       some convenient satellite signals,       enabling the command `whereami : Cmd (Int * Int)`.   properties: [pickable]-  capabilities: [senseloc]+  capabilities: [whereami] - name: tweezers   display:     attr: device@@ -1259,7 +1259,7 @@       `key : Text -> Key` constructs values of type `Key`{=type}, for       example `key "Down"` or `key "C-S-x"`.   properties: [pickable]-  capabilities: [handleinput]+  capabilities: [key, installKeyHandler] - name: halting oracle   display:     attr: device
data/recipes.yaml view
@@ -106,6 +106,24 @@     - [8, wooden gear]   out:     - [1, counter]+- in:+    - [1, rock]+    - [1, wooden gear]+  out:+    - [1, millstone]+- in:+    - [4, wheat]+  out:+    - [1, flour]+  required:+    - [1, millstone]+- in:+    - [1, flour]+    - [1, water]+  required:+    - [1, furnace]+  out:+    - [1, Elmer's glue] ######################################### ##                STONE                ## #########################################@@ -513,6 +531,15 @@     - [1, iron plate]   out:     - [1, tweezers]+- in:+    - [1, iron plate]+  out:+    - [1, caliper]+- in:+    - [1, paper]+    - [1, compass]+  out:+    - [1, atlas] ## MAGIC - in:     - [2, copper wire]@@ -658,6 +685,11 @@     - [1, lens]   required:     - [1, drill]+- in:+    - [2, copper pipe]+    - [2, lens]+  out:+    - [1, binoculars] - in:     - [1, glass]     - [8, copper wire]
data/scenarios/Challenges/00-ORDER.txt view
@@ -16,9 +16,12 @@ gallery.yaml wolf-goat-cabbage.yaml blender.yaml+dna.yaml friend.yaml pack-tetrominoes.yaml dimsum.yaml+telephone.yaml+flower-count.yaml Mazes Ranching Sokoban
data/scenarios/Challenges/2048.yaml view
@@ -9,11 +9,11 @@     condition: |       try {         as base {has "2048"}-      } { return false }+      } { pure false } solution: |   def makeN : Int -> Cmd Unit = \n.     if (n == 1)-      {harvest; return ()}+      {harvest; pure ()}       {makeN (n/2); makeN (n/2); make (format n)}   end;   place "1";@@ -103,6 +103,12 @@     description:       - A 2048.     properties: [pickable]+  - name: wall+    display:+      char: '#'+    description:+      - Unmovable barrier+    properties: [known, unwalkable, boundary] recipes:   - in:       - [2, "1"]@@ -176,14 +182,9 @@     {stone}   palette:     "Ω": [grass, null, base]-    "┌": [stone, upper left corner]-    "┐": [stone, upper right corner]-    "└": [stone, lower left corner]-    "┘": [stone, lower right corner]-    "─": [stone, horizontal wall]-    "│": [stone, vertical wall]+    'w': [stone, wall]   upperleft: [-1, 3]   map: |-    ┌─┐-    │Ω│-    └─┘+    www+    wΩw+    www
data/scenarios/Challenges/Mazes/easy_cave_maze.yaml view
@@ -46,7 +46,7 @@     system: true     program: |       def until = \c. b <- c; if b {} {until c} end;-      until (d <- scan down; return (d == inl ()));+      until (d <- scan down; pure (d == inl ()));       create "goal" known: [water] entities:
data/scenarios/Challenges/Mazes/easy_spiral_maze.yaml view
@@ -46,7 +46,7 @@     system: true     program: |       def until = \c. b <- c; if b {} {until c} end;-      until (d <- scan down; return (d == inl ()));+      until (d <- scan down; pure (d == inl ()));       create "goal" entities:   - name: wall
data/scenarios/Challenges/Mazes/invisible_maze.yaml view
@@ -10,17 +10,17 @@       try {         teleport self (27, -17);         b <- ishere "goal";-        return (not b)-      } { return false }+        pure (not b)+      } { pure false } solution: |   def tL = turn left end;   def tR = turn right end;   def ifC = \test. \then. \else. b <- test; if b then else end;   def forever = \c. c ; forever c end;-  def rightBlocked = tR; b <- blocked; tL; return b end;+  def rightBlocked = tR; b <- blocked; tL; pure b end;   def mazeStep = ifC rightBlocked {ifC blocked {tL} {move}} {tR; move} end;   build {-    forever (mazeStep; ifC (ishere "goal") {grab; return ()} {})+    forever (mazeStep; ifC (ishere "goal") {grab; pure ()} {})   } robots:   - name: base
data/scenarios/Challenges/Mazes/loopy_maze.yaml view
@@ -10,8 +10,8 @@       try {         teleport self (27, -17);         b <- ishere "goal";-        return (not b)-      } { return false }+        pure (not b)+      } { pure false } solution: |   run "scenarios/Challenges/Mazes/loopy_maze_sol.sw" robots:
data/scenarios/Challenges/Mazes/loopy_maze_sol.sw view
@@ -3,7 +3,7 @@ def tB = turn back end; def ifM = \p.\t.\e. b <- p; if b t e end; def DFS =-  ifM (ishere "goal") {grab; return ()} {};+  ifM (ishere "goal") {grab; pure ()} {};   ifM (ishere "rock") {} {     place "rock";     tL; b <- blocked; if b {} {move; DFS};@@ -14,5 +14,5 @@   tB; move; tB end; build {-  require 500 "rock"; DFS+  stock 500 "rock"; DFS }
data/scenarios/Challenges/Ranching/00-ORDER.txt view
@@ -3,3 +3,4 @@ powerset.yaml fishing.yaml gated-paddock.yaml+pied-piper.yaml
data/scenarios/Challenges/Ranching/_beekeeping/queenbee.sw view
@@ -8,12 +8,13 @@ def elif = \t. \then. \else. {if t then else} end def else = \t. t end -def sumTuples = \t1. \t2.-    (fst t1 + fst t2, snd t1 + snd t2);-    end;+def λcase = \f. \g. \s. case s f g end+def λmatch = \f. \p. match p f end -def mapTuple = \f. \t.-    (f $ fst t, f $ snd t)+def mapTuple = \f. λmatch \a. \b. (f a, f b) end;++def sumTuples = λmatch \t11. \t12. λmatch \t21. \t22.+    (t11 + t21, t12 + t22);     end;  def negateTuple = \t.@@ -25,9 +26,7 @@     end;  // Deprecated-def moveTuple = \tup.-    let x = fst tup in-    let y = snd tup in+def moveTuple = λmatch \x. \y.     turn $ if (x > 0) {east} {west};     doN (abs x) move; @@ -37,7 +36,7 @@  def randomDir =     r <- random 4;-    return $ if (r == 1) {north}+    pure $ if (r == 1) {north}         $ elif (r == 2) {west}         $ elif (r == 3) {south}         $ else {east};@@ -69,8 +68,7 @@          currLoc <- whereami;         let delta = subtractTuple goal currLoc in-        let x = fst delta in-        let y = snd delta in+        match delta \x. \y.          moveHorizontal maxDirect x;         moveVertical maxDirect y;@@ -117,8 +115,8 @@     };     end; -def goToHive = \hiveLoc.-    let depositLoc = (fst hiveLoc - 1, snd hiveLoc) in+def goToHive = λmatch \hivex. \hivey.+    let depositLoc = (hivex - 1, hivey) in     moveToward 2 depositLoc;     turn north;     depositHoneycomb 0;@@ -136,7 +134,7 @@         // another bee gets here first         try {             harvest;-            return ();+            pure ();         } {};     } {         // Include some random motion@@ -152,65 +150,29 @@     }     end; -/**-Searches through the existing instances of-a given structure template, starting at a supplied-index.-Either returns the (potentially new) index of the structure-(in the case that more had been built since the last check),-or unit. Re-using the newly found index amortizes the "search"-within the structure list over many ticks to constant time-rather than linear time.-*/-def findStructureNewIndex = \remainingCount. \structureLoc. \lastIdx.-    if (remainingCount > 0) {-        foundStructure <- structure "beehive" lastIdx;-        case foundStructure (\_. return $ inL ()) (\fs.-            if (structureLoc == snd fs) {-                return $ inR lastIdx;-            } {-                findStructureNewIndex (remainingCount - 1) structureLoc $ lastIdx + 1;-            }-        );+def workerProgram = \structureLoc.+    try {make "honeycomb";} {};+    hasHoneycomb <- has "honeycomb";+    if hasHoneycomb {+        goToHive structureLoc;     } {-        return $ inL ();-    }-    end;--def workerProgram = \hiveIdx. \structureLoc.-    eitherFoundStructure <- structure "beehive" hiveIdx;-    case eitherFoundStructure return (\fs.-        let hasSameStructure = structureLoc == snd fs in-        if hasSameStructure {-            try {make "honeycomb";} {};-            hasHoneycomb <- has "honeycomb";-            if hasHoneycomb {-                goToHive structureLoc;-            } {-                takeStepTowardItem "wildflower";-                return ();-            };-            workerProgram hiveIdx structureLoc;-        } {-            eitherNewIdx <- findStructureNewIndex (fst fs) structureLoc hiveIdx;-            case eitherNewIdx-                (\_. selfdestruct)-                (\newIdx. workerProgram newIdx structureLoc);-        }-    );+        takeStepTowardItem "wildflower";+        pure ();+    };+    workerProgram structureLoc;     end;  def mkBeeName = \structureLoc.     "bee" ++ format structureLoc;     end; -def workerProgramInit = \beename. \hiveIdx. \structureLoc.+def workerProgramInit = \beename. \structureLoc.     setname beename;     appear "B" (inl ());-    workerProgram hiveIdx structureLoc;+    workerProgram structureLoc;     end; -def createWorkerForStructure = \structureIdx. \fs.+def createWorkerForStructure = \loc.     // Build worker bee, assign ID, location     create "wax gland";     create "proboscis";@@ -236,38 +198,35 @@     create "treads";     create "workbench"; -    teleport self $ snd fs;-    let beename = mkBeeName (snd fs) in+    teleport self $ loc;+    let beename = mkBeeName loc in     build {-        require 1 "wax gland";-        workerProgramInit beename structureIdx $ snd fs;+        stock 1 "wax gland";+        workerProgramInit beename loc;     };-    return ();+    pure ();     end; -def associateAllHives = \remainingCount. \idx.-    if (remainingCount > 0) {--        foundStructure <- structure "beehive" idx;-        case foundStructure return (\fs.-            let beename = mkBeeName (snd fs) in-            try {-                // Fails if the robot does not exist-                robotnamed beename;-                return ();-            } {-                createWorkerForStructure idx fs;+def associateHive = \loc.+   let beename = mkBeeName loc in+   try {+       // Fails if the robot does not exist+       robotnamed beename;+       pure ();+   } {+       createWorkerForStructure loc; -                // Give the child robot time to register its new-                // name so that we don't end up spawning multiple-                // bees for the same location-                wait 1;-            };+       // Give the child robot time to register its new+       // name so that we don't end up spawning multiple+       // bees for the same location+       wait 1;+   };+   end; -            associateAllHives (remainingCount - 1) (idx + 1);-        );-    } {}-    end;+def mapM_ : (a -> Cmd b) -> (rec l. Unit + a * l) -> Cmd Unit = \f. λcase+  (\_. pure ())+  (λmatch \hd. \tl. f hd; mapM_ f tl)+  end;  /** Each tick, iterates through all hives,@@ -278,12 +237,8 @@ */ def observeHives = -    // This invocation is just to get the total structure count.-    // We will invoke it again once per iteration of 'associateAllHives'.-    foundStructure <- structure "beehive" 0;-    case foundStructure return (\fs.-        associateAllHives (fst fs) 0;-    );+    beehives <- structures "beehive";+    mapM_ associateHive beehives;      // Wait at least 1 tick so that we do not spin infinitely until     // we saturate our computation quota for the tick.
data/scenarios/Challenges/Ranching/_beekeeping/solution.sw view
@@ -11,12 +11,13 @@  def abs = \n. if (n < 0) {-n} {n} end; -def sumTuples = \t1. \t2.-    (fst t1 + fst t2, snd t1 + snd t2);-    end;+def λcase = \f. \g. \s. case s f g end+def λmatch = \f. \p. match p f end -def mapTuple = \f. \t.-    (f $ fst t, f $ snd t)+def mapTuple = \f. λmatch \a. \b. (f a, f b) end;++def sumTuples = λmatch \t11. \t12. λmatch \t21. \t22.+    (t11 + t21, t12 + t22);     end;  def negateTuple = \t.@@ -27,9 +28,7 @@     sumTuples t1 $ negateTuple t2;     end; -def moveTuple = \tup.-    let x = fst tup in-    let y = snd tup in+def moveTuple = λmatch \x. \y.     turn $ if (x > 0) {east} {west};     doN (abs x) move; @@ -113,14 +112,14 @@             collectContiguous maxdist item true $ dist + 1;         } {             if hadFound {-                return dist;+                pure dist;             } {                 move;                 collectContiguous maxdist item false $ dist + 1;             }         }     } {-        return dist;+        pure dist;     }     end; @@ -148,7 +147,7 @@          collectAllHoneycombs targetCount;     } {-        return currentCount;+        pure currentCount;     };     end; @@ -176,7 +175,7 @@     isRock <- ishere "rock";     if isRock {         grab;-        return ();+        pure ();     } {};     end; @@ -274,7 +273,7 @@     make "solar panel";      build {-        require 8 "tree";+        stock 8 "tree";         buildHive;          // Move to northwest corner
data/scenarios/Challenges/Ranching/_capture/opponent.sw view
@@ -41,9 +41,9 @@         isBlocked <- blocked;         turn left;         lastCount <- countBlocked $ n - 1;-        return $ lastCount + boolToInt isBlocked;+        pure $ lastCount + boolToInt isBlocked;     } {-        return 0;+        pure 0;     }     end; @@ -54,13 +54,15 @@ def locationIsOpen =     emptyHere <- isempty;     blockedCount <- countBlocked 4;-    return $ emptyHere && blockedCount == 0;+    pure $ emptyHere && blockedCount == 0;     end;  def faceAwayFrom = \loc.+    match loc \locx. \locy.     myLoc <- whereami;-    let x = fst loc - fst myLoc in-    let y = snd loc - snd myLoc in+    match myLoc \myx. \myy.+    let x = locx - myx in+    let y = locy - myy in     let d = if (abs x > abs y) {         if (x > 0) {west} {east}     } {@@ -84,7 +86,7 @@     findOpenArea;     try {         swap marker;-        return ();+        pure ();     } {         place marker;     };
data/scenarios/Challenges/Ranching/_fishing/hauler.sw view
@@ -9,35 +9,38 @@     } {};     end; -def isEnclosureFull = \idx.-    foundBox <- structure "rubbish enclosure" idx;-    case foundBox (\_. return false) (\enclosure.-        let boxPos = snd enclosure in-        -        prevLoc <- whereami;+def isEnclosureFull : Int * Int -> Cmd Bool = \encl.+    prevLoc <- whereami; -        dims <- floorplan "rubbish enclosure";-        teleport self boxPos;+    dims <- floorplan "rubbish enclosure";+    teleport self encl; -        c <- density ((0, 0), dims);-        let area = fst dims * snd dims in-        let notFull = c < area in+    c <- density ((0, 0), dims);+    match dims \w. \h.+    let area = w * h in+    let notFull = c < area in -        teleport self prevLoc;-        return $ not notFull;-    );+    teleport self prevLoc;+    pure $ not notFull;     end; +def λcase = \f. \g. \s. case s f g end+def λmatch = \f. \p. match p f end++def any : (a -> Cmd Bool) -> (rec l. Unit + a * l) -> Cmd Bool = \p. λcase+  (\_. pure false)+  (λmatch \hd. \tl. b <- p hd; if b {pure true} {any p tl})+end;+ def isEitherEnclosureFull =-    full1 <- isEnclosureFull 0;-    full2 <- isEnclosureFull 1;-    return $ full1 || full2;+    enclosures <- structures "rubbish enclosure";+    any isEnclosureFull enclosures     end;  def tryGrab =     try {         grab;-        return ()+        pure ()     } {};     end;
data/scenarios/Challenges/Ranching/_fishing/solution.sw view
@@ -17,7 +17,7 @@ def checkIngredients =     hasTuna <- has "crab";     hasSeaweed <- has "seaweed";-    return $ hasTuna && hasSeaweed;+    pure $ hasTuna && hasSeaweed;     end;  def catchFish = \rod.@@ -39,9 +39,9 @@ At the top-right corner */ def harvestRectangle =-    intersperse 4 move $ harvest; return ();+    intersperse 4 move $ harvest; pure ();     turnAround left;-    intersperse 4 move $ harvest; return ();+    intersperse 4 move $ harvest; pure ();     end;  def harvestIngredients =@@ -62,23 +62,13 @@     move;     end; -def getJunkItem = \idx.-    result <- tagmembers "junk" idx;-    let totalCount = fst result in-    let member = snd result in-    let nextIdx = idx + 1 in+def λcase = \f. \g. \s. case s f g end+def λmatch = \f. \p. match p f end -    hasProhibited <- has member;-    if hasProhibited {-        return $ inr member;-    } {-        if (nextIdx < totalCount) {-            getJunkItem nextIdx;-        } {-            return $ inl ();-        }-    }-    end;+def find : (a -> Cmd Bool) -> (rec l. Unit + a * l) -> Cmd (Unit + a) = \p. λcase+  (\_. pure (inl ()))+  (λmatch \hd. \tl. h <- p hd; if h {pure $ inr hd} {find p tl})+end  def tryPlace = \item.     try {@@ -120,7 +110,7 @@      end; -def returnToCorner =+def pureToCorner =     turn back;     move; move;     turn right;@@ -131,7 +121,7 @@ def unloadTrash =     try {         placeSerpentine (-            item <- getJunkItem 0;+            item <- find has (tagmembers "junk");             case item (\_. fail "done") (\item. place item);         );         watch down;@@ -155,7 +145,7 @@          intersperse 2 move $ (             placeSerpentine $ tryPlace "car tire";-            returnToCorner;+            pureToCorner;             ignite forward;              turn right;
data/scenarios/Challenges/Ranching/_gated-paddock/enclosure-checking.sw view
@@ -1,14 +1,14 @@ def isBlockedOrFenced =     b <- blocked;-    return b;+    pure b;     end;  def checkIsEnclosed =     maybePath <- path (inL ()) (inR "water");-    case maybePath (\_. return True) (\_. return False);+    case maybePath (\_. pure True) (\_. pure False);     end; -def boolToInt = \b. if (b) {return 1} {return 0}; end;+def boolToInt = \b. if (b) {pure 1} {pure 0}; end;  def countAdjacentBlockages = @@ -28,7 +28,7 @@     b4 <- isBlockedOrFenced;     c4 <- boolToInt b4; -    return $ c1 + c2 + c3 + c4;+    pure $ c1 + c2 + c3 + c4;     end;  // Step forward, observing left and right.@@ -44,7 +44,7 @@      turn right;     move;-    return $ val1 + val2;+    pure $ val1 + val2;     end;  @@ -65,7 +65,7 @@     // Second, step to both sides     fwdCount <- observeLeftAndRight;     backCount <- observeLeftAndRight;-    return $ fwdCount + backCount;+    pure $ fwdCount + backCount;     end;  def isStandingOnBridge =@@ -74,12 +74,12 @@     if (onFence || onGate) {         adjCount <- countAdjacentBlockages;         if (adjCount > 1) {-            return true;+            pure true;         } {             diagCount <- countDiagonalBlockages;-            return $ (adjCount + diagCount) > 1;+            pure $ (adjCount + diagCount) > 1;         };-    } {return false};+    } {pure false};     end;  def getValForSheepIndex = \predicateCmd. \i.@@ -91,7 +91,7 @@          boolToInt didSucceed;     } {-        return 0;+        pure 0;     }     end; @@ -99,7 +99,7 @@     val1 <- getValForSheepIndex predicateCmd 1;     val2 <- getValForSheepIndex predicateCmd 2;     val3 <- getValForSheepIndex predicateCmd 3;-    return $ val1 + val2 + val3;+    pure $ val1 + val2 + val3;     end;  justFilledGap <- as base {@@ -108,7 +108,7 @@  if (justFilledGap) {     enclosedCount <- countSheepWith checkIsEnclosed;-    return $ enclosedCount >= 1;+    pure $ enclosedCount >= 1; } {-    return false;+    pure false; }
data/scenarios/Challenges/Ranching/_gated-paddock/fence-construction.sw view
@@ -54,10 +54,10 @@  def harvestIfClover =     x <- scan down;-    case x return (\y.+    case x pure (\y.         if (y == "clover") {             harvest;-            return ();+            pure ();         } {};     );     end;@@ -125,11 +125,11 @@     turn right;     wait 200;     -    plantCloverColumn right $ return ();-    plantCloverColumn left $ return ();-    plantCloverColumn right $ return ();-    plantCloverColumn left $ return ();-    plantCloverColumn right $ return ();+    plantCloverColumn right $ pure ();+    plantCloverColumn left $ pure ();+    plantCloverColumn right $ pure ();+    plantCloverColumn left $ pure ();+    plantCloverColumn right $ pure ();     end;  @@ -164,10 +164,10 @@  def pickupWool =     x <- scan down;-    case x return (\y.+    case x pure (\y.         if (y == "wool") {             grab;-            return ();+            pure ();         } {};     );     end;
data/scenarios/Challenges/Ranching/_gated-paddock/meandering-sheep.sw view
@@ -5,12 +5,12 @@ def turnToClover = \direction.    x <- scan direction;-  case x (\_. return false;) (\y.+  case x (\_. pure false;) (\y.     if (y == "clover") {       turn direction;-      return true;+      pure true;     } {-      return false;+      pure false;     };   );   end;@@ -23,11 +23,11 @@ def turnCloverDirection =      foundN <- turnToClover north;-    if (foundN) {return true} {+    if (foundN) {pure true} {       foundE <- turnToClover east;  -      if (foundE) {return true} {+      if (foundE) {pure true} {         foundS <- turnToClover south;-        if (foundS) {return true} {+        if (foundS) {pure true} {           turnToClover west;         }       }@@ -38,7 +38,7 @@    let randdir : Cmd Dir =     d <- random 4;-    return $ if (d == 0) {+    pure $ if (d == 0) {         north       } $ elif (d == 1) {         east@@ -90,7 +90,7 @@      // Eat clover.     x <- scan down;-    case x return (\y.+    case x pure (\y.         if (y == "clover") {             harvest;             cloverCount <- count "clover";@@ -113,9 +113,9 @@         // Make sure nothing's in the way before we place         // our wool:         x <- scan down;-        case x return (\_.+        case x pure (\_.           grab;-          return ();+          pure ();         );          place item;
+ data/scenarios/Challenges/Ranching/_pied-piper/rat.sw view
@@ -0,0 +1,107 @@+def moveWithMorbidity =+    moldHere <- ishere "mold";+    if moldHere {+        try {+            // handle race conditions in which+            // another robot grabs it first+            m <- harvest;+            let spores = "mold spores" in+            if (m == spores) {+                say $ "Yuck, " ++ spores ++ "! I'm outta here.";+                selfdestruct;+            } {};+        } {};+    } {};+    move;+    end;++def λmatch = \f. \p. match p f end++def goFoodDir = \f. λmatch \d. \_. +    if (d == down) {+        foodHere <- ishere "oats";+        if foodHere {+            grab; pure ()+        } {};+        f;+        pure ()+    } {+        turn d;++        // An obstruction might arise after+        // navigation direction is determined+        // but before we move.+        try {+            moveWithMorbidity;+        } {};+        f;+    }+    end;++def goHomeDir = \f. λmatch \d. \_.+    if (d == down) {+        pure ()+    } {+        turn d;++        // An obstruction might arise after+        // navigation direction is determined+        // but before we move.+        try {+            moveWithMorbidity;+        } {};+        f;+    }+    end;++def findGoodDirection =+    isBlocked <- blocked;+    if isBlocked {+        turn left;+        findGoodDirection;+    } {};+    end;++def moveUntilBlocked =+    isBlocked <- blocked;+    if isBlocked {+    } {+        moveWithMorbidity;+        moveUntilBlocked;+    };+    end;++def pauseAtRandom =+    r <- random 3;+    if (r == 0) {+        r2 <- random 12;+        wait $ 6 + r2;+    } {}+    end;++def returnHome = \homeLoc.+    nextDir <- path (inL ()) (inL homeLoc);+    case nextDir pure $ goHomeDir $ returnHome homeLoc;+    end;++def pursueFood = \hadSensedFood. \homeLoc.+    nextDir <- path (inR 5) (inR "oats");+    case nextDir (\_. if hadSensedFood {returnHome homeLoc} {pure ()}) $+        goFoodDir $ pursueFood true homeLoc;+    end;++def doMovement = \startLoc.+    findGoodDirection;+    moveUntilBlocked;+    pauseAtRandom;+    pursueFood false startLoc;+    end;++/** Loop */+def go = \startLoc.+    doMovement startLoc;+    go startLoc;+    end;++startLoc <- whereami;+go startLoc;
+ data/scenarios/Challenges/Ranching/_pied-piper/solution.sw view
@@ -0,0 +1,191 @@+def doN = \n. \f. if (n > 0) {f; doN (n - 1) f} {}; end;+++def intersperse = \n. \f2. \f1. if (n > 0) {+        f1;+        if (n > 1) {+            f2;+        } {};+        intersperse (n - 1) f2 f1;+    } {};+    end;++def uTurn = \d.+    turn d;+    move;+    turn d;+    end;++/**+Starting at bottom right of field+*/+def harvestField = \fieldWidth.+    intersperse fieldWidth move harvest;+    uTurn right;+    intersperse fieldWidth move harvest;+    uTurn left;+    intersperse fieldWidth move harvest;+    uTurn right;+    intersperse fieldWidth move harvest;+    end;++def makeOatsCrumb = \spacing.+  place "oats";+  doN spacing move;+  end;++def waitUntilRatDisappeared =+  found <- scout east;+  if found {+      wait 1;+      waitUntilRatDisappeared;+  } {};+  end;++/**+Place a trail of breadcrumbs, and return+one crumb short of the first crumb.+*/+def makeOatsTrail = \spacing. \segments.+  doN segments $ makeOatsCrumb spacing;+  turn back;+  doN (segments * spacing) move;+  turn back;+  end;++def placeHorizontalTrail = \horizontalSpacing.+  turn east;+  doN (2*horizontalSpacing) move;+  place "oats";+  turn back;+  doN horizontalSpacing move;+  place "oats";+  doN horizontalSpacing move;+  turn left;+  end;++def waitForRatToPass =++  // Wait until the rat ate this crumb+  watch down;+  wait 2000;+  waitUntilRatDisappeared;+  end;++def makeTrails =+  let spacing = 4 in+  let segments = 5 in++  wait 30;+  placeHorizontalTrail 5;+  makeOatsTrail spacing $ segments + 1;+  end;++def getKey =+  turn east;+  doN 15 move;+  turn right;+  move;+  _k <- grab;+  turn right;+  doN 5 move;+  turn right;+  doN 6 move;+  turn left;+  doN 18 move;+  turn left;+  doN 20 move;+  turn right;+  doN 2 move;+  use "unlocker" forward;+  doN 6 move;+  turn right;+  doN 8 move;+  turn left;+  move;+  turn right;+  doN 6 move;+  turn left;+  move;+  end;++def placeMold = \moldItem.+  turn east;+  doN 11 move;+  sow moldItem;+  end;++def go =+  getKey;+  harvestField 20;++  turn left;+  doN 2 move;+  turn left;+  harvestField 20;+++  move;+  turn right;+  doN 14 move;+  turn left;++  // Get the mold+  doN 4 move;+  turn left;+  doN 3 move;+  moldItem <- grab;+  turn back;+  doN 3 move;++  turn right;+  doN 3 move;+  turn left;++  // Head back to the house+  doN 8 move;+  turn left;+  doN 8 move;+  turn left;++  // Start laying trail+  intersperse 5 (doN 4 move) $ place "oats";+  placeHorizontalTrail 5;++  waitForRatToPass;++  makeTrails;+  waitForRatToPass;+++  makeOatsTrail 4 10;+  placeHorizontalTrail 5;+  waitForRatToPass;++  makeOatsTrail 4 12;+  placeHorizontalTrail 5;+  waitForRatToPass;++  turn east;+  doN 2 move;++  placeHorizontalTrail 4;+  makeOatsTrail 4 4;+  waitForRatToPass;++  makeOatsTrail 4 6;+  placeHorizontalTrail 4;++  waitForRatToPass;+  makeOatsTrail 4 10;+  placeHorizontalTrail 4;+++  waitForRatToPass;+  makeOatsTrail 4 12;+  placeHorizontalTrail 4;++  placeMold moldItem;+  end;++go;
data/scenarios/Challenges/Ranching/_powerset/setup.sw view
@@ -9,7 +9,7 @@ def doN = \n. \f. if (n > 0) {f; doN (n - 1) f} {}; end;  def until = \p. \c. q <- p; if q {} {c; until p c} end;-def while = \p. until (x <- p; return $ not x) end;+def while = \p. until (x <- p; pure $ not x) end;  def isDivisibleBy = \dividend. \divisor.     (dividend / divisor) * divisor == dividend;@@ -67,7 +67,7 @@     teleport self newLoc;     retval <- f;     teleport self prevLoc;-    return retval;+    pure retval;     end;  def placeSand =@@ -86,7 +86,7 @@     if (isBitSet bitmask nextRandomVal) {         getUnusedRandom maxval bitmask;     } {-        return nextRandomVal;+        pure nextRandomVal;     }     end; @@ -140,7 +140,7 @@         nextRandomVal <- getUnusedRandom maxval bitmask;         let newBitmask = bitmask + shiftLeft 1 nextRandomVal in         naiveRandomStack valueFunc maxval newBitmask $ n - 1;-        return nextRandomVal;+        pure nextRandomVal;     } {         // We're at the peak of the stack.         // Now we unwind it.@@ -148,7 +148,7 @@         // Saves some time in generating the last number by inferring the         // only remaining possible choice.         let missingBit = getMissingBit bitmask maxval in-        return missingBit;+        pure missingBit;     };     valueFunc val;     end;@@ -170,7 +170,8 @@     if (x != 0 && x != exclusionValue && not (exactlyOneBit false x)) {         naiveRandomStack (placeEntsForBits x) inputCardinality 0 inputCardinality;         myloc <- whereami;-        teleport self (fst myloc + 1, 0);+        match myloc \x. \_.+        teleport self (x + 1, 0);     } {};     end; @@ -193,7 +194,7 @@     if (exactlyOneBit false value) {       chooseExclusionValue powersetCardinality;     } {-      return value;+      pure value;     }     end; @@ -208,7 +209,7 @@     move;     exclusionValue <- chooseExclusionValue powersetCardinality;     naiveRandomStack (columnFunc exclusionValue inputCardinality) powersetCardinality 0 powersetCardinality;-    return exclusionValue;+    pure exclusionValue;     end;  /**@@ -220,7 +221,7 @@  def checkSolutionSum = \runningSum.     maybeItem <- scan down;-    case maybeItem (\_. return runningSum) (\item.+    case maybeItem (\_. pure runningSum) (\item.         // The bell is the only other item we can place in this         // scenario besides the fruits.         if (item != "bell") {@@ -228,7 +229,7 @@             let binaryValue = shiftLeft 1 $ theOrdinal - 1 in             move;             checkSolutionSum $ binaryValue + runningSum;-        } {return runningSum};+        } {pure runningSum};     );     end;
data/scenarios/Challenges/Ranching/_powerset/solution.sw view
@@ -1,6 +1,6 @@ def doN = \n. \f. if (n > 0) {f; doN (n - 1) f} {}; end; def until = \p. \c. q <- p; if q {} {c; until p c} end;-def while = \p. until (x <- p; return $ not x) end;+def while = \p. until (x <- p; pure $ not x) end;  def abs = \n. if (n < 0) {-n} {n} end; @@ -14,12 +14,13 @@     } {};     end; -def mapTuple = \f. \t.-    (f $ fst t, f $ snd t)-    end;+def λcase = \f. \g. \s. case s f g end+def λmatch = \f. \p. match p f end -def sumTuples = \t1. \t2.-    (fst t1 + fst t2, snd t1 + snd t2);+def mapTuple = \f. λmatch \a. \b. (f a, f b) end;++def sumTuples = λmatch \t11. \t12. λmatch \t21. \t22.+    (t11 + t21, t12 + t22);     end;  def negateTuple = \t.@@ -28,7 +29,7 @@  def getRelativeLocation = \absCurrentLoc. \absDestLoc.     let negatedLoc = negateTuple absCurrentLoc in-    return $ sumTuples negatedLoc absDestLoc;+    pure $ sumTuples negatedLoc absDestLoc;     end;  def splitStride = \n.@@ -41,9 +42,7 @@     }     end; -def moveTuple = \tup.-    let x = fst tup in-    let y = snd tup in+def moveTuple = λmatch \x. \y.     turn $ if (x > 0) {east} {west};     // doN (abs x) move;     splitStride x;@@ -73,7 +72,7 @@  def tryHarvest = \stashLoc.     maybeItem <- scan down;-    case maybeItem return (\item.+    case maybeItem pure (\item.         hasSome <- has item;         harvest;         if hasSome {} {@@ -105,7 +104,7 @@     if emptyhere {         turn back;         splitStride tally;-        return tally;+        pure tally;     } {         move;         countLine $ tally + 1;@@ -114,7 +113,8 @@  def placeFinalCopy = \item.     originalLoc <- whereami;-    goToLocation originalLoc (fst originalLoc, 0);+    match originalLoc \x. \_.+    goToLocation originalLoc (x, 0);     until isempty move;     place item;     newLoc <- whereami;@@ -123,7 +123,7 @@  def copyIfNeeded = \targetCount.     maybeItem <- scan down;-    case maybeItem return (\item.+    case maybeItem pure (\item.         quantity <- count item;         if (quantity < targetCount) {             placeFinalCopy item;
data/scenarios/Challenges/Ranching/beekeeping.yaml view
@@ -32,8 +32,8 @@         judicious placement is essential for efficient         `honeycomb`{=entity} production.     condition: |-      foundStructure <- structure "beehive" 0;-      return $ case foundStructure (\_. false) (\_. true);+      foundStructure <- structures "beehive";+      pure $ case foundStructure (\_. false) (\_. true);   - teaser: Collect honeycomb     goal:       - |@@ -67,7 +67,7 @@     condition: |       as base {         meadCount <- count "mead";-        return $ meadCount >= 2;+        pure $ meadCount >= 2;       }   - teaser: Tavern keeper     optional: true@@ -75,8 +75,8 @@       - |         Construct a `mead hall`{=structure}.     condition: |-      foundStructure <- structure "mead hall" 0;-      return $ case foundStructure (\_. false) (\_. true);+      foundStructure <- structures "mead hall";+      pure $ case foundStructure (\_. false) (\_. true); robots:   - name: base     display:@@ -193,7 +193,7 @@     description:       - Senses direction to nectar-producing flowers     properties: [known, pickable]-    capabilities: [detectdirection, structure]+    capabilities: [chirp, structures]   - name: honey     display:       char: 'h'@@ -439,7 +439,6 @@       , mask lakes {lakewater}       ]   upperleft: [0, 0]-  offset: false   palette:     'B': [grass, erase, base]     'Q': [grass, erase, queenbee]
data/scenarios/Challenges/Ranching/capture.yaml view
@@ -25,10 +25,10 @@                   turn left;                   isSurrounded $ n - 1;               } {-                  return false;+                  pure false;               }           } {-              return true;+              pure true;           }           end; @@ -59,16 +59,16 @@               let localBlockCount = boolToInt isBlocked in               turn left;               lastCount <- countBlocked $ n - 1;-              return $ lastCount + localBlockCount;+              pure $ lastCount + localBlockCount;           } {-              return 0;+              pure 0;           }           end;        opponent <- robotnamed "opponent";       as opponent {           blockCount <- countBlocked 4;-          return $ blockCount > 0 && blockCount < 4;+          pure $ blockCount > 0 && blockCount < 4;       }; robots:   - name: base@@ -143,7 +143,6 @@   dsl: |     {grass}   upperleft: [0, 0]-  offset: false   palette:     'B': [grass, null, base]     '.': [grass]
data/scenarios/Challenges/Ranching/fishing.yaml view
@@ -29,7 +29,7 @@     condition: |       as base {         rollCount <- count "california roll";-        return $ rollCount >= 16;+        pure $ rollCount >= 16;       }     prerequisite: made_sushi   - teaser: Sushi chef@@ -59,26 +59,14 @@         Otherwise, when the enclosure becomes full, the trash         hauler will come to empty it.     condition: |-      // Returns true if prohibited item is in inventory.-      def checkProhibited = \idx.-        result <- tagmembers "junk" idx;-        let totalCount = fst result in-        let member = snd result in-        let nextIdx = idx + 1 in--        hasProhibited <- as base {has member};-        if hasProhibited {-          return false;-        } {-          if (nextIdx < totalCount) {-            checkProhibited nextIdx;-          } {-            return true;-          }-        }-        end;+      def hasAny : (rec l. Unit + Text * l) -> Cmd Bool = \items.+        case items+          (\_. pure false)+          (\c. match c \hd. \tl. b <- has hd; if b {pure true} {hasAny tl})+      end; -      checkProhibited 0;+      let prohibited = tagmembers "junk" in+      h <- hasAny prohibited; pure (not h)   - teaser: No littering     id: littered     hidden: true@@ -89,35 +77,41 @@       - |         Note that certain items can be burned with a `torch`{=entity} to make room.     condition: |-      def locIsInsideEnclosure = \loc. \dims. \idx.-        foundBox <- structure "rubbish enclosure" idx;-        case foundBox (\_. return false) (\enclosure.-          let boxPos = snd enclosure in-          return $ snd loc >= snd boxPos-            && snd loc < snd dims + snd boxPos-            && fst loc >= fst boxPos-            && fst loc < fst dims + fst boxPos;-        );+      def λmatch = \f. \p. match p f end+      def λcase = \f. \g. \s. case s f g end++      def locIsInsideEnclosure =+        λmatch \locx. \locy.+        λmatch \dimx. \dimy.+        λmatch \boxx. \boxy.+        pure $ locy >= boxy+          && locy < dimy + boxy+          && locx >= boxx+          && locx < dimx + boxx;         end;        def junkOutsideEnclosure =         result <- scan down;-        case result (\_. return false) (\item.-          isJunk <- hastag item "junk";+        case result (\_. pure false) (\item.+          let isJunk = hastag item "junk" in           if isJunk {-            foundBox <- structure "rubbish enclosure" 0;+            enclosures <- structures "rubbish enclosure"; -            case foundBox (\_. return false) (\enclosure.+            case enclosures (\_. pure false) (+              λmatch \enclosure0.+              λcase (\_. pure false) (+                λmatch \enclosure1. \_. -              dims <- floorplan "rubbish enclosure";-              loc <- whereami;+                dims <- floorplan "rubbish enclosure";+                loc <- whereami; -              insideFirst <- locIsInsideEnclosure loc dims 0;-              insideSecond <- locIsInsideEnclosure loc dims 1;-              return $ not $ insideFirst || insideSecond;-            );+                insideFirst <- locIsInsideEnclosure loc dims enclosure0;+                insideSecond <- locIsInsideEnclosure loc dims enclosure1;+                pure $ not $ insideFirst || insideSecond;+              )+            )           } {-            return false;+            pure false;           };         );         end;@@ -208,13 +202,11 @@     description:       - |         Can tell you if something is `junk`{=tag}-        via the `hastag` command. E.g.:+        via the `hastag` function. E.g.:       - |         `hastag "car tire" "junk"`       - |-        Also allows you to iterate over the list of junk, e.g.:-      - |-        `tagmembers "junk" 0`+        Also allows you to get the list of all junk items with `tagmembers "junk"`.     capabilities: [hastag, tagmembers]   - name: torch     display:@@ -507,16 +499,10 @@   dsl: |     {grass}   upperleft: [0, 0]-  placements:-    - src: rubbish enclosure-      offset: [19, -10]-    - src: rubbish enclosure-      offset: [19, -14]-      orient:-        up: south   palette:     'B': [grass, erase, base]     '.': [grass]+    'x': [blank]     'w': [grass, lakewater]     's': [grass, lakewater, shark]     'A': [grass, avocado]@@ -524,6 +510,16 @@     'c': [grass, cucumber]     'r': [dirt, erase]     'h': [dirt, erase, hauler]+    'e':+      structure:+        name: rubbish enclosure+      cell: [grass]+    'f':+      structure:+        name: rubbish enclosure+        orientation:+          up: south+      cell: [grass]   map: |     .........................h.     .........................r.@@ -535,10 +531,10 @@     .........wwwwwwww........r.     cccc.......wwww..........r.     cccc.....................r.-    .........................r.-    .........................r.-    .........................r.+    ...................exxxx.r.+    ...................xxxxx.r.+    ...................xxxxx.r.     ....................rrrrrr.-    ...........................-    ...........................-    ...........................+    ...................fxxxx...+    ...................xxxxx...+    ...................xxxxx...
data/scenarios/Challenges/Ranching/gated-paddock.yaml view
@@ -23,15 +23,15 @@     condition: |-       def isBlockedOrFenced =           b <- blocked;-          return b;+          pure b;           end;        def checkIsEnclosed =           maybePath <- path (inL ()) (inR "water");-          case maybePath (\_. return True) (\_. return False);+          case maybePath (\_. pure True) (\_. pure False);           end; -      def boolToInt = \b. if (b) {return 1} {return 0}; end;+      def boolToInt = \b. if (b) {pure 1} {pure 0}; end;        def countAdjacentBlockages = @@ -51,7 +51,7 @@           b4 <- isBlockedOrFenced;           c4 <- boolToInt b4; -          return $ c1 + c2 + c3 + c4;+          pure $ c1 + c2 + c3 + c4;           end;        // Step forward, observing left and right.@@ -67,7 +67,7 @@            turn right;           move;-          return $ val1 + val2;+          pure $ val1 + val2;           end;  @@ -88,7 +88,7 @@           // Second, step to both sides           fwdCount <- observeLeftAndRight;           backCount <- observeLeftAndRight;-          return $ fwdCount + backCount;+          pure $ fwdCount + backCount;           end;        def isStandingOnBridge =@@ -97,12 +97,12 @@           if (onFence || onGate) {               adjCount <- countAdjacentBlockages;               if (adjCount > 1) {-                  return true;+                  pure true;               } {                   diagCount <- countDiagonalBlockages;-                  return $ (adjCount + diagCount) > 1;+                  pure $ (adjCount + diagCount) > 1;               };-          } {return false};+          } {pure false};           end;        def getValForSheepIndex = \predicateCmd. \i.@@ -114,7 +114,7 @@                boolToInt didSucceed;           } {-              return 0;+              pure 0;           }           end; @@ -122,7 +122,7 @@           val1 <- getValForSheepIndex predicateCmd 1;           val2 <- getValForSheepIndex predicateCmd 2;           val3 <- getValForSheepIndex predicateCmd 3;-          return $ val1 + val2 + val3;+          pure $ val1 + val2 + val3;           end;        justFilledGap <- as base {@@ -131,9 +131,9 @@        if (justFilledGap) {           enclosedCount <- countSheepWith checkIsEnclosed;-          return $ enclosedCount >= 1;+          pure $ enclosedCount >= 1;       } {-          return false;+          pure false;       }   - id: feed_sheep     teaser: Feed sheep@@ -155,7 +155,7 @@               r <- robotnumbered i;               as r {predicateCmd};           } {-              return false;+              pure false;           };           end; @@ -164,12 +164,12 @@           if (i > 0) {               didSucceed <- getTruthForSheepIndex predicateCmd i;               if didSucceed {-                  return true;+                  pure true;               } {                   anySheep predicateCmd $ i - 1;               };           } {-              return false;+              pure false;           };           end;
+ data/scenarios/Challenges/Ranching/pied-piper.yaml view
@@ -0,0 +1,463 @@+version: 1+name: Infestation+author: Karl Ostmo+description: |+  Rid the village of pests.+creative: false+seed: 0+attrs:+  - name: clay+    bg: "#313020"+  - name: oats+    fg: "#444444"+    bg: "#F5DEB3"+  - name: bridge+    bg: "#806040"+  - name: brick+    bg: "#880000"+  - name: mold+    fg: "#406020"+    bg: "#403020"+terrains:+  - name: bridge+    attr: bridge+    description: |+      Wooden raised path+  - name: clay+    attr: clay+    description: |+      Damp, sandy soil+robots:+  - name: base+    loc:+      subworld: overworld+      loc: [-1, 8]+    dir: south+    devices:+      - ADT calculator+      - binoculars+      - branch predictor+      - comparator+      - compass+      - counter+      - dictionary+      - grabber+      - harvester+      - lambda+      - logger+      - net+      - rolex+      - scanner+      - seed spreader+      - strange loop+      - string+      - treads+      - unlocker+      - tweezers+    inventory: []+    walkable:+      never:+        - locked door+  - name: rat+    system: true+    dir: west+    display:+      invisible: false+      char: 'r'+    devices:+      - logger+    program: |+      run "scenarios/Challenges/Ranching/_pied-piper/rat.sw"+    walkable:+      never:+        - ladder+objectives:+  - teaser: Bait+    goal:+      - The village dwellings have been infested by `rat`{=robot}s. You are charged with clearing the infestation.+      - Scurrying feet can be heard through cracks under each `locked door`{=entity}. Unfortunately you've not been entrusted with `key`{=entity}s to the residences.+      - Perhaps there is something that would entice them out? North of the river you spy fields of `oats`{=entity} and a `storage silo`{=structure}.+      - Get some `oats`{=entity}.+    condition: |+      as base {+        has "oats";+      }+  - teaser: Silo+    id: silo+    goal:+      - Inspect the `storage silo`{=structure}.+    condition: |+      as base {+        loc <- locateme;+        match loc \l. \_.+        pure $ l == "silo";+      }+  - teaser: Moldy+    prerequisite: silo+    id: moldy+    goal:+      - A `rat`{=robot} will `selfdestruct` if it comes in contact with `mold`{=entity}.+      - Obtain some `mold spores`{=entity}.+    condition: |+      as base {+        has "mold spores";+      }+  - teaser: Corral+    prerequisite: moldy+    goal:+      - Dispatch the `rat`{=robot}s with `mold`{=entity}.+      - Note that `mold spores`{=entity} will only spread when `sow`n in a dark, damp environment.+    condition: |+      try {+        r <- robotNamed "rat";+        pure false;+      } {pure true}+  - teaser: Spelunker+    prerequisite: silo+    goal:+      - Find a secret passage.+      - To unlock a door, you need to `use "unlocker"`, which will consume a `key`{=entity}.+    condition: |+      as base {+        loc <- locateme;+        match loc \l. \_.+        pure $ l == "tunnel";+      }+solution: |+  run "scenarios/Challenges/Ranching/_pied-piper/solution.sw"+entities:+  - name: seed spreader+    display:+      char: 's'+    description:+      - A device to distribute seeds and spores+    properties: [known]+    capabilities: [sow]+  - name: brick+    display:+      char: '#'+      attr: brick+    description:+      - Sturdy building material+    properties: [known, unwalkable]+  - name: fence+    display:+      char: '#'+      attr: wood+    description:+      - Keeps interlopers away from the fields.+    properties: [known, unwalkable]+  - name: locked door+    display:+      char: 'D'+      attr: wood+    description:+      - door+    properties: [known]+  - name: unlocked door+    display:+      char: '/'+      attr: wood+    description:+      - Unlocked door+    properties: [known]+  - name: key+    display:+      char: 'k'+    description:+      - Used by an `unlocker`{=entity} to open a a `locked door`{=entity}+    properties: [known, pickable]+  - name: unlocker+    display:+      char: 'u'+    description:+      - Facilitates use of a `key`{=entity}+    properties: [known]+  - name: ladder+    display:+      char: 'H'+      attr: wood+    description:+      - Ladder. Rodents cannot climb this.+    properties: [known]+  - name: chute+    display:+      char: 'C'+    description:+      - A trapdoor to the netherworld+    properties: [known]+  - name: wall+    display:+      char: 'W'+      attr: wood+    description:+      - wall+    properties: [known, unwalkable, boundary]+  - name: oats+    display:+      attr: oats+      char: 't'+    description:+      - Grain+    properties: [known, pickable, growable]+    growth:+      duration: [40, 80]+    biomes: [dirt]+  - name: mold+    display:+      attr: mold+      char: 'm'+    description:+      - Spreads in dark, damp environments.+      - Toxic to `rat`{=robot}s.+      - Yields `mold spores`{=entity} when `harvest`ed or `grab`bed.+    properties: [known, pickable, growable]+    yields: mold spores+    growth:+      duration: [15, 30]+      spread:+        radius: 2+        density: 0.3+    biomes: [clay]+  - name: mold spores+    display:+      attr: mold+      char: '*'+    description:+      - Grows into `mold`{=entity} in dark, damp environments.+      - In spore form, has no effect on `rat`{=robot}s.+    properties: [known, pickable, growable]+    growth:+      duration: [15, 30]+      mature: mold+      spread:+        radius: 2+        density: 0.3+    biomes: [clay]+known: [water, boulder]+structures:+  - name: storage silo+    recognize:+      - north+    structure:+      mask: '.'+      palette:+        'x': [stone, brick]+        '=': [stone]+        'c':+          cell: [stone, chute]+          waypoint:+            name: chute_entrance+        'a': [blank, oats]+        'H':+          cell: [dirt, ladder]+          waypoint:+            name: well_top+      map: |+        ......xxxxxH.+        .....x===aax.+        ...xx===aaaax+        ....c==aaaaax+        ...xx=aaaaaax+        .....xaaaaax.+        ......xxxxx..+  - name: field+    structure:+      palette:+        'a': [dirt, oats]+      map: |+        aaaaaaaaaaaaaaaaaaaa+        aaaaaaaaaaaaaaaaaaaa+        aaaaaaaaaaaaaaaaaaaa+        aaaaaaaaaaaaaaaaaaaa+subworlds:+  - name: silo+    mask: '+'+    palette:+      '.': [clay]+      's': [stone, boulder]+      'k': [clay, key]+      'w':+        cell: [clay]+        waypoint:+          name: chute_exit+      'H':+        cell: [stone, ladder]+        waypoint:+          name: well_bottom+    portals:+      - entrance: well_bottom+        exitInfo:+          exit: well_top+          subworldName: overworld+    upperleft: [-1, 1]+    map: |+      +++++sHsss++++++      +++ss.....ss++++      ++s.........s+++      +s...........s++      +s.....w.....s++      +s.........k.s++      ++s.........s+++      +++ss.....ss++++      +++++sssss++++++  - name: tunnel+    mask: '+'+    palette:+      '.': [dirt]+      'x': [stone, boulder]+      'm': [dirt, mold]+      'H':+        cell: [dirt, ladder]+        waypoint:+          name: underground_field_ladder+      'I':+        cell: [dirt, ladder]+        waypoint:+          name: underground_house_ladder+    portals:+      - entrance: underground_field_ladder+        exitInfo:+          exit: field_ladder+          subworldName: overworld+        consistent: true+      - entrance: underground_house_ladder+        exitInfo:+          exit: house_ladder+          subworldName: overworld+        consistent: true+    upperleft: [-1, 1]+    map: |+      ++xHx+xx++      ++x.xx.mx+      ++x.xxm.x+      ++x.xxx.x+      ++x.....x+      +++x.xxxx+      +++x.x++++      +++x.x++++      +++xIx++++recipes:+  - in:+      - [1, locked door]+      - [1, key]+    out:+      - [1, unlocked door]+    required:+      - [1, unlocker]+world:+  name: overworld+  structures:+    - name: house ladder+      structure:+        palette:+          'w': [stone, wall]+          'H':+            cell: [dirt, ladder]+            waypoint:+              name: house_ladder+        map: |+          www+          wHw+    - name: field ladder+      structure:+        palette:+          'H':+            cell: [dirt, ladder]+            waypoint:+              name: field_ladder+        map: H+    - name: house+      structure:+        palette:+          'd': [stone, locked door]+          'x': [stone, wall]+          '.': [stone]+          'r': [stone, erase, rat]+        map: |+          xxxxxxxxx+          x.......x+          d.......x+          x.......x+          x....r..x+          x.......x+          xxxxxxxxx+    - name: street pair+      structure:+        placements:+          - src: house+            offset: [0, 0]+            orient:+              up: south+          - src: house+            offset: [16, 0]+            orient:+              flip: true+        map: ""+    - name: block+      structure:+        placements:+          - src: street pair+            offset: [0, 0]+            orient:+              flip: true+          - src: street pair+            offset: [0, 8]+        map: ""+  placements:+    - src: block+      offset: [-10, -14]+    - src: block+      offset: [-10, -36]+    - src: storage silo+      offset: [8, 9]+    - src: field+      offset: [-28, 12]+    - src: field+      offset: [-28, 7]+    - src: field+      offset: [-52, 12]+    - src: field+      offset: [-52, 7]+    - src: field ladder+      offset: [-8, 2]+    - src: house ladder+      offset: [-8, -5]+  upperleft: [-2, 2]+  portals:+    - entrance: well_top+      exitInfo:+        exit: well_bottom+        subworldName: silo+    - entrance: chute_entrance+      exitInfo:+        exit: chute_exit+        subworldName: silo+    - entrance: field_ladder+      exitInfo:+        exit: underground_field_ladder+        subworldName: tunnel+    - entrance: house_ladder+      exitInfo:+        exit: underground_house_ladder+        subworldName: tunnel+  dsl: |+    overlay+    [ {grass}+    , mask (x == -7 && y >= 3 || y == 3 && x <= -7) {fence}+    , mask (y > -2 && y < 2) {water}+    , mask (x > -3 && x < 3) {stone}+    , mask (y > -25 && y < -19) {stone}+    ]+  palette:+    'b': [bridge, erase]+    'M':+      cell: [bridge, erase]+      waypoint:+        name: bridge_top+  map: |+    Mbbbb+    bbbbb+    bbbbb+    bbbbb+    bbbbb
data/scenarios/Challenges/Ranching/powerset.yaml view
@@ -99,7 +99,7 @@     description:       - Allows one to `stride` across multiple cells     properties: [known, pickable]-    capabilities: [movemultiple]+    capabilities: [stride]   - name: bell     display:       char: 'B'@@ -182,7 +182,6 @@   dsl: |     {grass}   upperleft: [-1, -1]-  offset: false   palette:     'B': [grass, null, base]     'S': [grass, null, setup]
data/scenarios/Challenges/Sliding Puzzles/3x3.yaml view
@@ -157,16 +157,16 @@     display:       char: 'G'     description:-      - Generates a magnetic field gradient that allows the use of `resonate`+      - Generates a magnetic field gradient that allows the use of `resonate` and `density`.     properties: [known]-    capabilities: [detectcount]+    capabilities: [resonate, density]   - name: locator     display:       char: '{'     description:-      - Enables the `detect` command+      - Enables the `detect` command.     properties: [known]-    capabilities: [detectloc]+    capabilities: [detect]   - name: border     display:       char: '▒'@@ -724,7 +724,6 @@   dsl: |     {grass}   upperleft: [-3, 2]-  offset: false   palette:     B: [grass, null, base]     y: [grass, null, setup]
data/scenarios/Challenges/Sliding Puzzles/_sliding-puzzle/maintainer.sw view
@@ -16,7 +16,9 @@     end  def sumTuples = \t1. \t2.-    (fst t1 + fst t2, snd t1 + snd t2);+    match t1 \t11. \t12.+    match t2 \t21. \t22.+    (t11 + t21, t12 + t22);     end;  /** Teleports to a new location to execute a function@@ -28,12 +30,12 @@     teleport self newLoc;     retval <- f;     teleport self prevLoc;-    return retval;+    pure retval;     end;  def itemIsHere = \item.     x <- scan down;-    case x (\_. return false) (\found. return $ found == item);+    case x (\_. pure false) (\found. pure $ found == item);     end;  def getLetterEntityByIndex = \idx.@@ -52,7 +54,7 @@  def getValueHere =     maybeItem <- scan down;-    ordNum <- case maybeItem (\_. return 0) getOrdinal;+    ordNum <- case maybeItem (\_. pure 0) getOrdinal;     end;  def getIndexesTotal = \boardWidth. \boardHeight. \n.@@ -61,9 +63,9 @@         teleport self (idx/boardHeight, -(mod idx boardWidth));         valueHere <- getValueHere;         runningTotal <- getIndexesTotal boardWidth boardHeight $ n - 1;-        return $ valueHere + runningTotal;+        pure $ valueHere + runningTotal;     } {-        return 0;+        pure 0;     }     end; @@ -77,7 +79,7 @@     let tileCount = squareCount - 1 in     let indicesSum = computeTriangularNumber tileCount in     mySum <- getIndexesTotal boardWidth boardHeight squareCount;-    return $ indicesSum - mySum;+    pure $ indicesSum - mySum;     end;  def replenishInk =@@ -114,12 +116,12 @@ def hasAdjacentBlank = \tileIdx. \n.     if (n > 0) {         result <- scan forward;-        case result (\_. handleLegalMove tileIdx; return true;) (\_.+        case result (\_. handleLegalMove tileIdx; pure true;) (\_.             turn left;             hasAdjacentBlank tileIdx $ n - 1;         );     } {-        return false;+        pure false;     }     end; @@ -141,7 +143,7 @@ def handleMarker = \boardWidth. \boardHeight.     detectReferenceLoc <- whereami;     result <- detect "sliding-tile" ((0, 0), (boardWidth - 1, boardHeight - 1));-    case result return (\badLoc.+    case result pure (\badLoc.         teleportToDetectResult detectReferenceLoc badLoc;         missingIdx <- atLocation (0, 0) $ findMissingIndex boardWidth boardHeight;         markIsLegal <- isLegalMark missingIdx;@@ -173,7 +175,8 @@         isOnRightBorder <- itemIsHere b;         if isOnRightBorder {             loc <- whereami;-            teleport self (0, snd loc - 1);+            match loc \_. \y.+            teleport self (0, y - 1);         } {};         iterateAllTiles func;     }
data/scenarios/Challenges/Sliding Puzzles/_sliding-puzzle/setup.sw view
@@ -29,7 +29,7 @@  def getValueHere =     maybeItem <- scan down;-    ordNum <- case maybeItem (\_. return 0) getOrdinal;+    ordNum <- case maybeItem (\_. pure 0) getOrdinal;     end;  /**@@ -81,9 +81,9 @@         let addend = if (referenceVal > valueHere) {1} {0} in         recursiveSum <- countInnerInversions n referenceVal $ j + 1;         let foo = recursiveSum in-        return $ addend + foo;+        pure $ addend + foo;     } {-        return 0;+        pure 0;     };     end @@ -102,9 +102,9 @@         turn back;         subarrayInversions <- countInversions n $ i + 1;         let foo = subarrayInversions in-        return $ innerCountFoo + foo;+        pure $ innerCountFoo + foo;     } {-        return 0;+        pure 0;     };     end @@ -115,13 +115,13 @@ def scanValid : Dir -> Cmd (Bool + Text) = \d.     maybeTileForward <- scan d;     case maybeTileForward-        (\_. return $ inL false)+        (\_. pure $ inL false)         (\x.             if (x == "sliding-tile") {-                return $ inL true;+                pure $ inL true;             } {                 y <- getOrdinal x;-                return $ if (y > 0) {+                pure $ if (y > 0) {                     inR x;                 } {                     inL false;@@ -145,14 +145,14 @@             move;             grab;             // Abort early from the recursion.-            return false;+            pure false;         } {             // The new tile is not a sliding tile.             // We assume it's a blank tile and move there.             // If it turns out not to be blank, that will             // be addressed in the outer "observe" loop.             move;-            return false;+            pure false;         };     ) (\newItem.         let isSame = newItem == original in@@ -160,7 +160,7 @@         if isSame {} {             say $ "Original was " ++ original ++ "; newItem was " ++ newItem;         };-        return isSame;+        pure isSame;     );     end; @@ -179,14 +179,14 @@                 // Our assumption was invalid; we don't have a                 // valid reference tile to compared the drilled tile to.                 say "Unexpected drilling; no reference tile.";-                return false;+                pure false;             } {-                return true;+                pure true;             }         ) (actOnItemComparison maybeItem2);-        return keepGoing;+        pure keepGoing;     } {-        return false;+        pure false;     };     end; @@ -249,7 +249,8 @@  def placeRandomizedPuzzle = \arrayLoc. \boardWidth. \rowIndex.     if (rowIndex >= 0) {-        placeSingleRow (snd arrayLoc) boardWidth rowIndex $ boardWidth - 1;+        match arrayLoc \_. \array_y.+        placeSingleRow array_y boardWidth rowIndex $ boardWidth - 1;         placeRandomizedPuzzle arrayLoc boardWidth $ rowIndex - 1;     } {};     end;
data/scenarios/Challenges/Sliding Puzzles/_sliding-puzzle/solution.sw view
@@ -27,14 +27,14 @@  def abs = \n. if (n < 0) {-n} {n} end; -def mapTuple = \f. \t.-    (f $ fst t, f $ snd t)-    end;+def λmatch = \f. \p. match p f end -def sumTuples = \t1. \t2.-    (fst t1 + fst t2, snd t1 + snd t2);+def sumTuples = λmatch \t11. \t12. λmatch \t21. \t22.+    (t11 + t21, t12 + t22);     end; +def mapTuple = \f. λmatch \a. \b. (f a, f b) end;+ def getOrdinal : Text -> Cmd Int = \item.     count $ item ++ "-ordinal";     end;@@ -57,13 +57,13 @@ def getRelativeLocation = \absLoc.     myloc <- whereami;     let negatedLoc = negateTuple myloc in-    return $ sumTuples negatedLoc absLoc;+    pure $ sumTuples negatedLoc absLoc;     end;  def getRelativeRectangle : (Int * Int) * (Int * Int) -> Cmd ((Int * Int) * (Int * Int)) = \corners.     myloc <- whereami;     let negatedLoc = negateTuple myloc in-    return $ mapTuple (sumTuples negatedLoc) corners;+    pure $ mapTuple (sumTuples negatedLoc) corners;     end;  /**@@ -82,9 +82,7 @@     loc <- detect entName corners;     end; -def moveTuple = \tup.-    let x = fst tup in-    let y = snd tup in+def moveTuple = λmatch \x. \y.     turn $ if (x > 0) {east} {west};     doN (abs x) move; @@ -108,14 +106,12 @@ we should extract the vertical or horizontal dimension. */ def getRectDimension = \vertical. \rect.-    let extractor = if vertical {snd} {fst} in-    let tuple = mapTuple extractor rect in-    abs $ snd tuple - fst tuple;+    let extractor = if vertical {λmatch \a. \_. a} {λmatch \_. \b. b} in+    match (mapTuple extractor rect) \a. \b.+    abs $ b - a;     end; -def getOffsets = \rect.-    subtractTuple (snd rect) (fst rect);-    end;+def getOffsets = λmatch \a. \b. subtractTuple b a end;  def getAbsDelta = \rect.     let difference = getOffsets rect in@@ -124,7 +120,7 @@  def distance = \loc1. \loc2.     let d = getAbsDelta (loc1, loc2) in-    fst d + snd d;+    match d \a. \b. a + b     end;  // NOT USED@@ -146,17 +142,13 @@     mapTuple (\x. x + 1) absDifference;     end; -def getRectArea = \dims.-    fst dims * snd dims;-    end;+def getRectArea = λmatch \w. \h. w * h end;  /** Determines whether the vertical dimension is larger than the horizontal dimension. */-def isVerticalLarger = \dims.-    snd dims > fst dims;-    end;+def isVerticalLarger = λmatch \w. \h. h > w; end;  /** Returns a tuple of the two rectangle partitions.@@ -168,21 +160,21 @@ The "rightward/downward offset" (i.e. +1 horizontally, -1 vertically) to the "avg" for the second rectangle depends on this assumption. */-def splitRectangle = \vertically. \rect.-    let cornerA = fst rect in-    let cornerB = snd rect in+def splitRectangle = \vertically. λmatch \cornerA. \cornerB.+    match cornerA \ax. \ay.+    match cornerB \bx. \by.     if vertically {         // TODO: We should "round down" the height of the second partition         // so that the first partition is more likely to contain         // the target (i.e. we perform one fewer iteration).-        let avgY = (snd cornerA + snd cornerB) / 2 in-        let firstRect = (cornerA, (fst cornerB, avgY)) in-        let secondRect = ((fst cornerA, avgY - 1), cornerB) in+        let avgY = (ay + by) / 2 in+        let firstRect = (cornerA, (bx, avgY)) in+        let secondRect = ((ax, avgY - 1), cornerB) in         (firstRect, secondRect)     } {-        let avgX = (fst cornerA + fst cornerB) / 2 in-        let firstRect = (cornerA, (avgX, snd cornerB)) in-        let secondRect = ((avgX + 1, snd cornerA), cornerB) in+        let avgX = (ax + bx) / 2 in+        let firstRect = (cornerA, (avgX, by)) in+        let secondRect = ((avgX + 1, ay), cornerB) in         (firstRect, secondRect)     };     end;@@ -191,7 +183,7 @@     entCount <- density rect;     let dims = getDimensions rect in     let tileCount = getRectArea dims in-    return $ entCount < tileCount;+    pure $ entCount < tileCount;     end;  /**@@ -204,24 +196,23 @@ The "first" partition in a horizontal split is the "left" partition. */ def findEmptyCell = \foundCriteria. \rect.-    +     let dims = getDimensions rect in     let tileCount = getRectArea dims in      if (tileCount < 1) {-        return $ inL ();+        pure $ inL ();     } $ elif (tileCount == 1) {         foundHere <- foundCriteria rect;-        return $ if foundHere {-            inR $ fst rect;+        pure $ if foundHere {+            match rect \w. \_. inR w;         } {             inL ();         };     } $ else {         let isBiggerVertically = isVerticalLarger dims in         let splitted = splitRectangle isBiggerVertically rect in-        let firstPartition = fst splitted in-        let secondPartition = snd splitted in+        match splitted \firstPartition. \secondPartition.          foundInFirst <- foundCriteria firstPartition;         let selectedPartition = if foundInFirst {firstPartition} {secondPartition} in@@ -237,13 +228,17 @@ It is assumed that one of the candidates will meet this criteria, so we only need check the first. */-def avoidCollinear = \blankloc. \tileloc. \loc1. \loc2.-    let firstOk = if (fst blankloc == fst tileloc) {-            fst loc1 != fst tileloc-        } $ elif (snd blankloc == snd tileloc) {-            snd loc1 != snd tileloc+def avoidCollinear =+    λmatch \blankx. \blanky.+    λmatch \tilex. \tiley.+    λmatch \loc1x. \loc1y.+    \loc2.+    let firstOk = if (blankx == tilex) {+            loc1x != tilex+        } $ elif (blanky == tiley) {+            loc1y != tiley         } $ else {true} in-    if firstOk {loc1} {loc2};+    if firstOk {(loc1x, loc1y)} {loc2};     end;  /**@@ -258,11 +253,14 @@ */ def getInitialBlankDestination = \blankLoc. \letterloc. \targetloc.     let getCoord = \f. signum (f targetloc - f letterloc) + f letterloc in-    avoidCollinear blankLoc letterloc (getCoord fst, snd letterloc) (fst letterloc, getCoord snd);+    let fst = λmatch \a. \_. a in+    let snd = λmatch \_. \b. b in+    match letterloc \letterx. \lettery.+    avoidCollinear blankLoc letterloc (getCoord fst, lettery) (letterx, getCoord snd);     end;  def moveSpaceToTile = \blankLoc. \targetRelativeLoc. \letterloc.-    +     log $ "first letter loc: " ++ format letterloc;      // Note: this rectangle might not be "normalized" in terms@@ -297,7 +295,7 @@     log $ "absolute target loc: " ++ format targetLocAbsolute;     targetRelativeLoc <- getRelativeLocation targetLocAbsolute; -//    case eitherLetterloc return $ moveSpaceToTile blankLoc targetRelativeLoc;+//    case eitherLetterloc pure $ moveSpaceToTile blankLoc targetRelativeLoc;     moveTuple blankLoc;     end; @@ -412,7 +410,7 @@     corners <- getBoardRectangle;     eitherBlankLoc <- findEmptyCell blankCellLocatorCriteria corners; -    case eitherBlankLoc return $ placeTile boardWidth 1;+    case eitherBlankLoc pure $ placeTile boardWidth 1;      moveManually;     end;
data/scenarios/Challenges/Sliding Puzzles/_sliding-puzzle/validate-board.sw view
@@ -4,7 +4,7 @@  def itemIsHere = \item.     x <- scan down;-    case x (\_. return false) (\found. return $ found == item);+    case x (\_. pure false) (\found. pure $ found == item);     end;  def getOrdinal : Text -> Cmd Int = \item.@@ -19,10 +19,10 @@ def isMonotonic : Int -> Cmd (Unit + Int) = \expectedVal.     maybeItem <- scan down;     case maybeItem-        (\_. return $ inR expectedVal) // Cell was blank+        (\_. pure $ inR expectedVal) // Cell was blank         (\entity.             intVal <- getOrdinal entity;-            return $ if (intVal == expectedVal) {+            pure $ if (intVal == expectedVal) {                 inR $ expectedVal + 1;             } {                 inL ();@@ -41,17 +41,18 @@ def loopMonotonicityCheck : Int -> Cmd Bool = \expectedVal.     isOnBottomBorder <- itemIsHere "border";     if isOnBottomBorder {-        return true;+        pure true;     } {         maybeNextVal <- isMonotonic expectedVal;         case maybeNextVal-            (\_. return false)+            (\_. pure false)             (\nextVal.                 move;                 isOnRightBorder <- itemIsHere "border";                 if isOnRightBorder {                     loc <- whereami;-                    teleport self (0, snd loc - 1);+                    match loc \_. \y.+                    teleport self (0, y - 1);                 } {};                 loopMonotonicityCheck nextVal;             );@@ -65,7 +66,7 @@         teleport self (0, 0);         loopMonotonicityCheck 1;     } {-        return false;+        pure false;     };     end;
data/scenarios/Challenges/Sokoban/Gadgets/no-reverse.yaml view
@@ -69,7 +69,6 @@   dsl: |     {grass, water}   upperleft: [-1, 1]-  offset: false   palette:     'B': [grass, erase, base]     '.': [grass, erase]
data/scenarios/Challenges/Sokoban/Gadgets/one-way.yaml view
@@ -52,7 +52,6 @@   dsl: |     {grass, water}   upperleft: [-1, 1]-  offset: false   palette:     'B': [grass, erase, base]     '.': [grass, erase]
data/scenarios/Challenges/Sokoban/Simple/trapdoor.yaml view
@@ -104,7 +104,6 @@   dsl: |     {grass, water}   upperleft: [-1, 1]-  offset: false   palette:     'B': [ice, erase, base]     '.': [grass, erase]
data/scenarios/Challenges/Sokoban/foresight.yaml view
@@ -92,13 +92,12 @@       char: '#'     description:       - Unmovable barrier-    properties: [known, unwalkable]+    properties: [known, unwalkable, boundary] known: [mountain, water, 3D printer, flower] world:   dsl: |     {grass, water}   upperleft: [-21, 10]-  offset: false   palette:     'B': [ice, erase, base]     '.': [grass, erase]
data/scenarios/Challenges/_blender/apprehension-checker.sw view
@@ -2,12 +2,12 @@     let basename = "base" in     x <- as r {whoami};     if (x == basename) {-        return false;+        pure false;     } {         mr0 <- as r {meet};         case mr0-          (\_. return false)-          (\bot. name <- as bot {whoami}; return $ name == basename);+          (\_. pure false)+          (\bot. name <- as bot {whoami}; pure $ name == basename);     };     end; @@ -26,11 +26,11 @@         let foo = intermediate in         let newIdx = idx + 1 in         recursiveResult <- anyHasMetBase newIdx;-        return $ foo || recursiveResult;+        pure $ foo || recursiveResult;     } {       // Terminates the recursion on the       // lowest index at which a robot does not exist-      return false;+      pure false;     };     end;
data/scenarios/Challenges/_bridge-building/flower-ring-check.sw view
@@ -3,13 +3,13 @@  def isItemInDirection = \direction. \item.      x <- scan direction;-    return $ case x (\_. false) (\y. y == item);+    pure $ case x (\_. false) (\y. y == item);     end;  def isFlankedByItem = \item.     hasLeft <- isItemInDirection left item;     hasRight <- isItemInDirection right item;-    return $ hasLeft && hasRight;+    pure $ hasLeft && hasRight;     end;  def flowersInCardinalDirections = \item. \n.@@ -19,10 +19,10 @@             turn left;             flowersInCardinalDirections item $ n - 1;         } {-            return false;+            pure false;         };     } {-        return true;+        pure true;     }     end; @@ -38,12 +38,12 @@             isFlanked2 <- isFlankedByItem item;             turn back;             move;-            return isFlanked2;+            pure isFlanked2;         } {-            return false;+            pure false;         }     } {-        return false;+        pure false;     }     end;
data/scenarios/Challenges/_bucket-brigade/hauler.sw view
@@ -27,8 +27,8 @@     traverseRoad;     doNTimesOr 40 (         briquetteIsHere <- ishere briquette;-        if briquetteIsHere {grab; return ()} {};-        return briquetteIsHere;+        if briquetteIsHere {grab; pure ()} {};+        pure briquetteIsHere;     );     turn back;     traverseRoad;
data/scenarios/Challenges/_combo-lock/setup.sw view
@@ -18,8 +18,7 @@     if (remainingCount > 0) {          let splitted = split 1 colorString in-        let nextLetter = fst splitted in-        let remainingLetters = snd splitted in+        match splitted \nextLetter. \remainingLetters.         let expectedPixel = pixelFromColor nextLetter in          move;@@ -31,7 +30,7 @@         // Replace the cell watches         doN stepsTaken (watch down; move);         turn back;-        return noMismatchYet;+        pure noMismatchYet;     };     end; @@ -41,7 +40,7 @@     move;     turn left;     doN n (grab; move);-    return ()+    pure ()     end;  def doUntilCorrect = \colorString.@@ -49,7 +48,7 @@     if isCorrect {         let remainingCount = chars colorString in         unlockGate remainingCount;-        return true;+        pure true;     } {         wait 1000;         doUntilCorrect colorString;@@ -69,7 +68,7 @@         createCombo $ newColor ++ colorString;     } {         turn back;-        return colorString;+        pure colorString;     };     end;
data/scenarios/Challenges/_combo-lock/solution.sw view
@@ -10,7 +10,7 @@         if (n > 0) {             drill down;             maybeNextEnt <- scan east;-            case maybeNextEnt return (\_. turn east; move; cycleCombos 3);+            case maybeNextEnt pure (\_. turn east; move; cycleCombos 3);             cycleCombos $ n - 1;         } {             turn west;
data/scenarios/Challenges/_dimsum/cook.sw view
@@ -1,11 +1,11 @@ def modifyCart = \cartType. \device.     result <- scan forward;-    case result return (\item.+    case result pure (\item.         if (item == cartType) {             use device forward;-            return ();+            pure ();         } {-            return ();+            pure ();         };     );     end;
data/scenarios/Challenges/_dimsum/patron.sw view
@@ -1,11 +1,11 @@ def modifyCart = \cartType. \device.     result <- scan forward;-    case result return (\item.+    case result pure (\item.         if (item == cartType) {             use device forward;-            return ();+            pure ();         } {-            return ();+            pure ();         };     );     end;
+ data/scenarios/Challenges/_dna/lab.sw view
@@ -0,0 +1,190 @@+def doN = \n. \f. if (n > 0) {f; doN (n - 1) f} {}; end;++def waypointByIndexRec : (rec l. Unit + (Int * Int) * l) -> Int -> (Int * Int) = \wps. \idx.++    case wps (\_. fail "invalid index") (\cons.+        match cons \hd. \tl.+        if (idx == 0) {+            hd;+        } {+            waypointByIndexRec tl $ idx - 1;+        }+    );+    end;++def waypointByIndex : Text -> Int -> (Int * Int) = \wpName. \idx.+    let wpList = waypoints wpName in+    waypointByIndexRec wpList idx;+    end;++def getBaseForNumber = \n.+    if (n == 0) {+        "guanine";+    } {+        if (n == 1) {+            "cytosine";+        } {+            if (n == 2) {+                "adenine";+            } {+                "thymine";+            };+        };+    };+    end;++def getNumberForBase = \n.+    if (n == "guanine") {+        0;+    } {+        if (n == "cytosine") {+            1;+        } {+            if (n == "adenine") {+                2;+            } {+                3;+            };+        };+    };+    end;++/** Toggle the lowest bit */+def getComplementNumber = \n.+    if (n == 0) {+        1;+    } {+        if (n == 1) {+            0;+        } {+            if (n == 2) {+                3;+            } {+                2;+            };+        };+    };+    end;++def waitUntilSomethingExists =+    maybeItemHere <- scan down;+    case maybeItemHere (\_. +        watch down;+        wait 1000;+        waitUntilSomethingExists;+    ) pure;+    end;++def waitUntilHere = \item.+    hereNow <- ishere item;+    if hereNow {} {+        watch down;+        wait 1000;+        waitUntilHere item;+    };+    end;++def waitUntilOccupied =+    stillEmpty <- isempty;+    if stillEmpty {+        watch down;+        wait 1000;+        waitUntilOccupied;+    } {};+    end;++def myStandby = \receptacleLoc.+    teleport self receptacleLoc;+    entToClone <- grab;+    teleport self (36, -11);+    turn back;+    pure $ inR entToClone;+    end;++def placeBase = \standbyFunc. \n. ++    if (n > 0) {+        idx <- random 4;+        let entTemp = getBaseForNumber idx in+        let ent = entTemp in+        create ent;+        place ent;+        move;++        clonedOrganism <- placeBase standbyFunc $ n - 1;++        // Unwinds the stack; verifies the original placement order+        placedEnt <- instant waitUntilSomethingExists;+        let isGood = ent == placedEnt in+        move;++        if isGood {+            pure clonedOrganism;+        } {+            pure $ inL ();+        }+    } {+        // Returns the clonedOrganism+        standbyFunc;+    };+    end;++def makeDnaStrand = \receptacleLoc.+    teleport self (5, -2);++    dims <- floorplan "DNA decoder";+    match dims \decoderWidth. \_.+    eitherClonedOrganism <- placeBase (myStandby receptacleLoc) decoderWidth;++    case eitherClonedOrganism (\_.+        create "pixel (R)";+    ) (\clonedItem.+        instant $ (+            teleport self (0, -11);+            waitUntilHere "switch (on)";++            let receptacleLoc2 = waypointByIndex "receiver" 1 in+            teleport self receptacleLoc2;++            sow clonedItem;+            create clonedItem;+            k <- robotnamed "keeper";+            give k clonedItem;++            let slideBox = "slide box" in+            create slideBox;+            give base slideBox;+            say $ "You got a new \"" ++ slideBox ++ "\"";+        );+    );+    end;++def waitForCloneableOrganism =+    let receptacleLoc = waypointByIndex "receiver" 0 in+    organism <- instant (+        teleport self receptacleLoc;++        waitUntilOccupied;++        thingHere <- scan down;+        pure $ case thingHere (\x. inL x) (\item.+          if (hastag item "organism") {inR item} {inL ()}+        )+    );++    case organism (\_.+        say "Not a cloneable organism!";+        waitForCloneableOrganism;+    ) (\_.+        create "pixel (G)";+        makeDnaStrand receptacleLoc;+    );+    end;++def go =+    waitForCloneableOrganism;+    turn east;+    go;+    end;++go;
+ data/scenarios/Challenges/_dna/mirrorbot.sw view
@@ -0,0 +1,99 @@+def doN = \n. \f. if (n > 0) {f; doN (n - 1) f} {}; end;++def getBaseForNumber = \n.+    if (n == 0) {+        "guanine";+    } {+        if (n == 1) {+            "cytosine";+        } {+            if (n == 2) {+                "adenine";+            } {+                "thymine";+            };+        };+    };+    end;++def getNumberForBase = \n.+    if (n == "guanine") {+        0;+    } {+        if (n == "cytosine") {+            1;+        } {+            if (n == "adenine") {+                2;+            } {+                if (n == "thymine") {+                    3;+                } {-1};+            };+        };+    };+    end;++/** Toggle the lowest bit */+def getComplementNumber = \n.+    if (n == 0) {+        1;+    } {+        if (n == 1) {+            0;+        } {+            if (n == 2) {+                3;+            } {+                2;+            };+        };+    };+    end;++def placeComplementOf = \item.+    let baseNumber = getNumberForBase item in+    if (baseNumber >= 0) {+        let complementNumber = getComplementNumber baseNumber in+        let newItem = getBaseForNumber complementNumber in+        move;+        create newItem;+        place newItem;+    } {+        let sludge = "organic sludge" in+        create sludge;+        place sludge;+    }+    end;++def waitUntilHere =+    watch down;+    wait 1000;++    maybeItemDown <- scan down;+    case maybeItemDown (\_. waitUntilHere) (\itemHere.+        placeComplementOf itemHere;+    );+    end;++def waitUntilEmpty =+    watch down;+    wait 1000;+    emptyHere <- isempty;+    if emptyHere {+        // reset the position+        turn back;+        move;+        turn back;+    } {+        waitUntilEmpty;+    }+    end;++def go =+    instant waitUntilHere;+    waitUntilEmpty;+    go;+    end;++go;
+ data/scenarios/Challenges/_dna/resetter.sw view
@@ -0,0 +1,48 @@+def doN = \n. \f. if (n > 0) {f; doN (n - 1) f} {}; end;++/**+Assumes we are on the left edge of a row of nucleobases+*/+def resetPlayfieldRow =+    dims <- floorplan "DNA decoder";+    match dims \decoderWidth. \_.+    doN decoderWidth (grab; move;);+    end;++def resetPlayfield =+    teleport self (5, -2);+    resetPlayfieldRow;+    teleport self (5, -3);+    resetPlayfieldRow;++    teleport self (5, -11);+    resetPlayfieldRow;+    teleport self (5, -12);+    resetPlayfieldRow;+    end;++def watchSwitch = \lastState.+    watch down;+    wait 1000;+    found <- scan down;+    case found pure (\item.+        if (item != lastState) {+            if (item == "switch (off)") {+                loc <- whereami;+                resetPlayfield;+                teleport self loc;+            } {+            };+        } {};+        watchSwitch item;+    );+    end;++def go =+    instant $ (+        found <- scan down;+        case found pure watchSwitch;+    );+    end;++go;
+ data/scenarios/Challenges/_dna/solution.sw view
@@ -0,0 +1,262 @@+def doN = \n. \f. if (n > 0) {f; doN (n - 1) f} {}; end;++def moveUntilBlocked =+    blockedHere <- blocked;+    if blockedHere {} {+        move;+        moveUntilBlocked;+    }+    end;++def getBaseForNumber = \n.+    if (n == 0) {+        "guanine";+    } {+        if (n == 1) {+            "cytosine";+        } {+            if (n == 2) {+                "adenine";+            } {+                "thymine";+            };+        };+    };+    end;++def getNumberForBase = \n.+    if (n == "guanine") {+        0;+    } {+        if (n == "cytosine") {+            1;+        } {+            if (n == "adenine") {+                2;+            } {+                3;+            };+        };+    };+    end;++/** Toggle the lowest bit */+def getComplementNumber = \n.+    if (n == 0) {+        1;+    } {+        if (n == 1) {+            0;+        } {+            if (n == 2) {+                3;+            } {+                2;+            };+        };+    };+    end;++def waitWhileHere = \item.+    stillHere <- ishere item;+    if stillHere {+        watch down;+        wait 1000;+        waitWhileHere item;+    } {};+    end;++def waitUntilHere = \item.+    hereNow <- ishere item;+    if hereNow {} {+        watch down;+        wait 1000;+        waitUntilHere item;+    };+    end;++def moveToPattern =+    turn back;+    doN 5 move;+    turn left;+    doN 4 move;+    turn left;+    move;+    end;++def moveToOtherRow =+    turn right;+    doN 2 move;+    turn right;+    doN 4 move;+    turn left;+    doN 4 move;+    turn left;+    doN 4 move;+    turn right;+    doN 2 move;+    turn right;+    move;+    end;++def waitForItem : Dir -> Cmd Text = \d.+    item <- scan d;+    case item (\_.+        watch d;+        wait 1000;+        waitForItem d;+    ) pure;+    end;++def waitForSpecificItem = \item. \d.+    itemIsHere <- ishere item;+    if itemIsHere {+    } {+        watch d;+        wait 1000;+        waitForSpecificItem item d;+    }+    end;++def placeComplementOf = \item.+    let baseNumber = getNumberForBase item in+    let complementNumber = getComplementNumber baseNumber in+    let newItem = getBaseForNumber complementNumber in+    place newItem;+    end;++/**+Store the observed entities in the recursion stack.+*/+def replicatePattern = \standbyFunc. \n.+    if (n > 0) {+        thingTemp <- waitForItem left;+        let thing = thingTemp in+        placeComplementOf thing;+        move;+        replicatePattern standbyFunc $ n - 1;++        place thing;+        move;+    } {+        standbyFunc;+    }+    end;++/**+Position self at entrance+*/+def pickFlowerAndWater =+    doN 6 move;+    dahlia <- grab;++    turn left;+    doN 8 move;+    turn right;+    doN 31 move;+    clover <- grab;+    turn back;+    doN 35 move;+    d <- grab;+    doN 10 move;++    turn left;++    doN 18 move;+    use "siphon" forward;+    turn left;+    doN 7 (+        move;+        use "siphon" right;+    );+    doN 4 move;+    turn right;+    doN 16 move;++    mushroom <- grab;++    turn back;+    doN 23 move;++    turn right;+    pure dahlia;++    // pure mushroom;+    // pure d;+    end;+++def waitUntilOccupied =+    stillEmpty <- isempty;+    if stillEmpty {+        watch down;+        wait 1000;+        waitUntilOccupied;+    } {};+    end;++def returnToInputReceptacle =+    turn back;+    doN 5 move;+    turn left;+    moveUntilBlocked;+    turn left;+    doN 29 move;+    turn right;+    moveUntilBlocked;+    turn left;+    doN 4 move;+    turn right;+    doN 6 move;+    turn right;+    moveUntilBlocked;+    end;++def completeDnaTask = \sentinel.+    place sentinel;+    make "specimen slide";++    doN 16 $ make "cytosine";++    waitWhileHere sentinel;+    moveToPattern;+    replicatePattern moveToOtherRow 32;++    // Activate the switch+    doN 3 move;+    drill forward;+    wait 2;+    drill forward;++    turn left;+    doN 6 move;+    turn left;+    doN 32 move;+    turn left;+    doN 2 move;+    turn left;+    move;++    waitUntilOccupied;+    grab;++    returnToInputReceptacle;+    end;++def λcase = \f. \g. \s. case s f g end+def λmatch = \f. \p. match p f end++def mapM_ : (a -> Cmd b) -> (rec l. Unit + a * l) -> Cmd Unit = \f. λcase+  (\_. pure ())+  (λmatch \hd. \tl. f hd; mapM_ f tl)+end;++def go =+    _sentinel <- pickFlowerAndWater;+    moveUntilBlocked;++    let organisms = tagmembers "organism" in+    mapM_ completeDnaTask organisms;+    end;++go;
+ data/scenarios/Challenges/_dna/topchecker.sw view
@@ -0,0 +1,107 @@+def doN = \n. \f. if (n > 0) {f; doN (n - 1) f} {}; end;++def getBaseForNumber = \n.+    if (n == 0) {+        "guanine";+    } {+        if (n == 1) {+            "cytosine";+        } {+            if (n == 2) {+                "adenine";+            } {+                "thymine";+            };+        };+    };+    end;++def getNumberForBase = \n.+    if (n == "guanine") {+        0;+    } {+        if (n == "cytosine") {+            1;+        } {+            if (n == "adenine") {+                2;+            } {+                if (n == "thymine") {+                    3;+                } {-1};+            };+        };+    };+    end;++/** Toggle the lowest bit */+def getComplementNumber = \n.+    if (n == 0) {+        1;+    } {+        if (n == 1) {+            0;+        } {+            if (n == 2) {+                3;+            } {+                2;+            };+        };+    };+    end;++def waitUntilHere = \remainingCount.+    if (remainingCount > 0) {+        maybeItemHere <- scan down;+        case maybeItemHere (\_. +            watch down;+            wait 1000;+            waitUntilHere remainingCount;+        ) (\itemHere.++            maybeItemAbove <- scan left;+            case maybeItemAbove (\_. fail "Expected an item here.") (\itemAbove.+                let num = getNumberForBase itemAbove in+                if (num >= 0) {+                    let complementNum = getComplementNumber num in+                    let complementItem = getBaseForNumber complementNum in+                    if (complementItem == itemHere) {+                        move;+                        waitUntilHere $ remainingCount - 1;+                    } {+                        create "pixel (R)";+                    }+                } {+                    fail "Expected nonnegative item index."+                }+            );+        );+    } {+        create "pixel (G)";+    };+    end;++def waitUntilEmpty =+    watch down;+    wait 1000;+    emptyHere <- isempty;+    if emptyHere {} {+        waitUntilEmpty;+    }+    end;++def waitForReset =+    backup;+    waitUntilEmpty;+    end;++def go = \startingLoc.+    instant $ waitUntilHere 32;+    waitForReset;+    teleport self startingLoc;+    go startingLoc;+    end;++loc <- whereami;+go loc;
+ data/scenarios/Challenges/_flower-count/judge.sw view
@@ -0,0 +1,35 @@+def win =+  try {+    firestarter <- robotNamed "firestarter";+    halt firestarter+  } {};+  try {+    fire <- robotNamed "fire";+    halt fire; wait 1;+    reprogram fire { selfdestruct };+  } {};+  create "gold"+end++def judgeCount : Int -> Cmd Unit = \actual.+  watch down;+  wait 1024;+  s <- scan down;+  case s+    (\_. pure ())+    (\p.+      try {+        let c = read @Int p in+        if (c == actual) { win } {}+      } {}+    )+end++def forever = \c. c; forever c end++def judge =+  numFlowers <- resonate "flower" ((-59,-19),(60,20));+  forever (judgeCount numFlowers);+end;++judge
+ data/scenarios/Challenges/_flower-count/solution.sw view
@@ -0,0 +1,114 @@+def doN : Int -> Cmd a -> Cmd Unit = \n. \c.+  if (n == 0) {} {c; doN (n-1) c}+end++def abs : Int -> Int = \n.+  if (n < 0) {-n} {n}+end++def λmatch = \f. \p. match p f end+def λcase = \f. \g. \s. case s f g end++// Go to the given absolute coordinates.  End facing east.+def goto : Int * Int -> Cmd Unit = λmatch \destx. \desty.+  cur <- whereami;+  match cur \x. \y.+  let dx = destx - x in+  let dy = desty - y in+  if (dx < 0) {turn west} {turn east};+  doN (abs dx) move;+  if (dy < 0) {turn south} {turn north};+  doN (abs dy) move;+  turn east;+end++def liftA2 : (a -> b -> c) -> Cmd a -> Cmd b -> Cmd c = \f. \ca. \cb.+  a <- ca;+  b <- cb;+  pure (f a b)+end++def add : Cmd Int -> Cmd Int -> Cmd Int = liftA2 (\x. \y. x + y) end++def countCell : Cmd Int =+  s <- scan down;+  pure $ case s+    (\_. 0)+    (\t. if (t == "flower") {1} {0})+end++tydef List a = rec l. Unit + (a * l) end++def sum : List Int -> Int = λcase+  (\_. 0)+  (λmatch \hd. \tl. hd + sum tl)+end++def for : Int -> (Int -> Cmd a) -> Cmd (List a) = \n. \k.+  if (n == 0) {pure (inl ())} {a <- k n; b <- for (n-1) k; pure (inr (a,b))}+end++def countRow : Int -> Cmd Int = \w.+  ns <- for (w-1) (\_. n <- countCell; move; pure n);+  last <- countCell;+  pure (sum ns + last)+end++def isEven : Int -> Bool = \n. (n / 2) * 2 == n end++def around : Dir -> Cmd Unit = \d. turn d; move; turn d end++// countFlowers (w,h) (x,y) counts the number of flowers+// in the w by h rectangle with lower-left corner at (x,y)+def countFlowers : Int * Int -> Int * Int -> Cmd Int = \size. \ll.+  goto ll;+  match size \w. \h.+  cnts <- for (h-1) (\i.+    cnt <- countRow w;+    if (isEven i) { around right } { around left };+    pure cnt+  );+  last <- countRow w;+  pure (sum cnts + last)+end++def acquire : Cmd Text =+  thing <- atomic (b <- isempty; if b {pure ""} {grab});+  if (thing == "") {acquire} {pure thing}+end++def countAndReport : Int * Int -> Int * Int -> Cmd Unit = \size. \ll.+  cnt <- countFlowers size ll;+  goto (0,0);+  paper <- acquire;+  let soFar = read @Int paper in+  erase paper;+  newPaper <- print "paper" (format (soFar + cnt));+  place newPaper;+end++def until : Cmd Bool -> Cmd a -> Cmd Unit = \test. \body.+  b <- test; if b {} {body; until test body}+end++def acquireFlower : Cmd Unit =+  until (ishere "flower") move; grab; pure ()+end++def go =+  for 4 (\r.+    for 3 (\c.+      build {countAndReport (40,10) (-59 + 40*(c-1), -19 + 10*(r-1))}+    )+  );+  print "paper" "0";+  turn left; move; place "paper: 0";+  wait 1024;+  acquireFlower;+  turn back;+  goto (20,0);+  res <- meet;+  case res (\_. pure ()) (\truelove. give truelove "flower")+end;++go;
data/scenarios/Challenges/_friend/cat.sw view
@@ -11,7 +11,7 @@  def randdir : Cmd Dir =   d <- random 4;-  return (+  pure (     if (d == 0) {north}     $ elif (d == 1) {east}     $ elif (d == 2) {south}@@ -21,7 +21,7 @@  def chooseWait : Cmd Int =   t <- random (16*2);-  return (16 + t)+  pure (16 + t) end  def wander =@@ -37,9 +37,11 @@  def follow : Cmd Unit -> Actor -> Cmd Unit = \cat. \r.   rLoc <- as r {whereami};+  match rLoc \rx. \ry.   myLoc <- whereami;-  let dx = fst rLoc - fst myLoc in-  let dy = snd rLoc - snd myLoc in+  match myLoc \myx. \myy.+  let dx = rx - myx in+  let dy = ry - myy in   if (abs dx > abs dy)   { if (dx < 0) {turn west} {turn east} }   { if (dy < 0) {turn south} {turn north} };
data/scenarios/Challenges/_friend/friend-solution.sw view
@@ -11,7 +11,7 @@ end;  build {-  require 3 "fish";+  stock 3 "fish";   m2; turn left; m20;   give_fish 3;   turn back; m20; turn right; m2
data/scenarios/Challenges/_gallery/setup.sw view
@@ -1,3 +1,5 @@+instant (+ def doN = \n. \f. if (n > 0) {f; doN (n - 1) f} {}; end;  def isDivisibleBy = \dividend. \divisor.@@ -60,7 +62,7 @@     if (isBitSet bitmask nextRandomVal) {         getUnusedRandom maxval bitmask;     } {-        return nextRandomVal;+        pure nextRandomVal;     }     end; @@ -75,7 +77,7 @@         nextRandomVal <- getUnusedRandom maxval bitmask;         let newBitmask = bitmask + shiftLeft 1 nextRandomVal in         naiveRandomStack valueFunc maxval newBitmask $ n - 1;-        return nextRandomVal;+        pure nextRandomVal;     } {         // We're at the peak of the stack.         // Now we unwind it.@@ -83,18 +85,28 @@         // Saves some time in generating the last number by inferring the         // only remaining possible choice.         let missingBit = getMissingBit bitmask maxval in-        return missingBit;+        pure missingBit;     };     valueFunc val;     end; -def getEntName = \idx.-    result <- tagmembers "bust" idx;-    return $ snd result;-    end;+def λcase = \f. \g. \s. case s f g end+def λmatch = \f. \p. match p f end +def index : Int -> (rec l. Unit + a * l) -> a = \i. λcase+  (\_. fail "bad index")+  (λmatch \hd. \tl. if (i == 0) {hd} {index (i-1) tl})+end++def length : (rec l. Unit + a * l) -> Int = λcase+  (\_. 0) (λmatch \_. \tl. 1 + length tl)+end++def busts : (rec l. Unit + Text * l) = tagmembers "bust" end+def bustCount : Int = length busts end+ def placeThing = \entIdx.-    entName <- getEntName entIdx;+    let entName = index entIdx busts in     create entName;     place entName;     end;@@ -116,13 +128,10 @@ "idx" counts upwards. */ def populateInventory = \baseCount. \idx.-    -    result <- tagmembers "bust" idx;-    let total = fst result in -    if (idx < total) {+    if (idx < bustCount) { -        let item = snd result in+        let item = index idx busts in          // Give copies to the base         baseExtras <- random 5;@@ -143,19 +152,18 @@     end;  def setup =-    result <- tagmembers "bust" 0;-    let totalCount = fst result in-     populateInventory 0 0; -    naiveRandomStack placeEntByIndex totalCount 0 totalCount;+    naiveRandomStack placeEntByIndex bustCount 0 bustCount;     turn back;     move;     create "bitcoin";     end;  def go =-    instant setup;+    setup;     end;  go;++)
data/scenarios/Challenges/_gallery/solution.sw view
@@ -3,7 +3,7 @@ def countRow = \currentCount.     emptyHere <- isempty;     if emptyHere {-        return currentCount;+        pure currentCount;     } {         move;         countRow $ 1 + currentCount;@@ -12,9 +12,9 @@  def getOrdinal = \d.     maybeEntity <- scan d;-    case maybeEntity (\nothing. return $ inL nothing) (\item.+    case maybeEntity (\nothing. pure $ inL nothing) (\item.         myCount <- count item;-        return $ inR myCount;+        pure $ inR myCount;     );     end; @@ -72,7 +72,7 @@     thisOrdinal <- if (remainingSteps > 1) {         getOrdinal right;     } {-        return $ inL ();+        pure $ inL ();     };      case thisOrdinal (\_.@@ -83,9 +83,9 @@         let shouldSwap = num < previousOrdinal in         ordinal <- if shouldSwap {             doSwap;-            return previousOrdinal;+            pure previousOrdinal;         } {-            return num;+            pure num;         };         move;         swapAdjacent (remainingSteps - 1) ordinal;@@ -96,7 +96,7 @@     if (unsortedCount > 1) {         prevOrdinal <- getOrdinal right;         move;-        case prevOrdinal return $ swapAdjacent unsortedCount;+        case prevOrdinal pure $ swapAdjacent unsortedCount;         doLoop $ unsortedCount - 1;     } {}     end;
data/scenarios/Challenges/_gopher/gopher.sw view
@@ -7,9 +7,9 @@ def randSign = \x.     opposite <- random 2;     if (opposite == 1) {-        return (-x);+        pure (-x);     } {-        return x;+        pure x;     }     end; @@ -33,8 +33,10 @@     end;  def converge = \dest. \currentLoc.-    let xDist = fst currentLoc - fst dest in-    let yDist = snd currentLoc - snd dest in+    match dest \destx. \desty.+    match currentLoc \curx. \cury.+    let xDist = curx - destx in+    let yDist = cury - desty in     randSwap (goDir xDist east west) (goDir yDist north south);     end; @@ -84,7 +86,7 @@                 // but *before* it executes `grab`, the gopher will crash.                 // Thus we have wrapped this `grab` in a `try`.                 grab;-                return ();+                pure ();             } {};         };     } {};@@ -94,9 +96,9 @@     newCount <- count dropping;     if (newCount > 0) {         let tauntStage = getTauntStage startingAmount newCount in-        let tauntIndex = fst tauntStage in+        match tauntStage \tauntIndex. \taunt.         if (tauntIndex != lastTauntIndex) {-            say $ snd tauntStage;+            say taunt         } {};          appear "o" (inl ());@@ -115,7 +117,7 @@             place reward;         } {             swap reward;-            return ();+            pure ();         };          baseloc <- as base {whereami};
data/scenarios/Challenges/_gopher/solution.sw view
@@ -34,15 +34,15 @@     let d = getDirection n in     out <- scan d;     shouldContinue <- case out-        (\_. return true)+        (\_. pure true)         (\x. if (x == "mound") {             drill d;-            return true;+            pure true;         } {             // A "flower" shall serve as             // a semaphore to terminate the loop,             // so that the base can `salvage` us.-            return $ x != "flower";+            pure $ x != "flower";         });      if shouldContinue {@@ -58,7 +58,7 @@  def deploySensor =     _s <- build {scanDirections 0};-    return ();+    pure ();     end;  def isDivisibleBy = \dividend. \divisor.@@ -100,13 +100,13 @@ def pickupToolkit =     x <- scan down;     case x-        (\_. return false)+        (\_. pure false)         (\y. if (y == "toolkit") {             tk <- grab;             equip tk;-            return true+            pure true         } {-            return false+            pure false         });     end;
data/scenarios/Challenges/_hackman/ghost.sw view
@@ -6,7 +6,7 @@  def isItemInDirection = \direction. \item.     x <- scan direction;-    return $ case x (\_. false) (\y. y == item);+    pure $ case x (\_. false) (\y. y == item);     end;  // A ghost is not blocked by a "gate" when it is leaving the "nursery".@@ -14,27 +14,27 @@     isGate <- isItemInDirection forward "gate";     loc <- whereami;     let amCentered = loc == (0, 0) in-    return $ isGate && amCentered;+    pure $ isGate && amCentered;     end;  def isBlockedAhead =     isBlockedByWall <- blocked;     ghostCanCrossGate <- canCrossGate;-    return $ isBlockedByWall && not ghostCanCrossGate;+    pure $ isBlockedByWall && not ghostCanCrossGate;     end;  def checkLeftBlocked =     turn left;     isBlocked <- isBlockedAhead;     turn right;-    return isBlocked;+    pure isBlocked;     end;  def checkRightBlocked =     turn right;     isBlocked <- isBlockedAhead;     turn left;-    return isBlocked;+    pure isBlocked;     end;  def chooseDirection : Cmd Dir =@@ -43,7 +43,7 @@     forwardBlocked <- isBlockedAhead;     if (leftBlocked && rightBlocked && forwardBlocked) {         say "Dead end; turning back";-        return back;+        pure back;     } {         // Since we're in the "else" case of all three         // being blocked, we know that at least one@@ -51,13 +51,13 @@         // the combinations.         if (leftBlocked && rightBlocked) {             // Keep going straight-            return forward;+            pure forward;         } {             if (leftBlocked && forwardBlocked) {-                return right;+                pure right;             } {                 if (rightBlocked && forwardBlocked) {-                    return left;+                    pure left;                 } {                     // Now we have exhaused all of the combinations                     // of *two* directions being blocked, so we@@ -67,30 +67,30 @@                         // Decide whether to go right or straight                         d <- random 2;                         if (d == 0) {-                            return right;+                            pure right;                         } {                             // go straight-                            return forward;+                            pure forward;                         }                     } {                         if rightBlocked {                             // Decide whether to go left or straight                             d <- random 2;                             if (d == 0) {-                                return left;+                                pure left;                             } {                                 // go straight-                                return forward;+                                pure forward;                             }                         } {                             if forwardBlocked {                                 // Decide whether to go left or right                                 d <- random 2;                                 if (d == 0) {-                                    return left;+                                    pure left;                                 } {                                     // go right-                                    return right;+                                    pure right;                                 }                             } {                                 // No directions are blocked, so we can@@ -99,13 +99,13 @@                                  d <- random 3;                                 if (d == 0) {-                                    return left;+                                    pure left;                                 } {                                     if (d == 1) {-                                        return right;+                                        pure right;                                     } {                                         // go straight-                                        return forward;+                                        pure forward;                                     }                                 }                             }
data/scenarios/Challenges/_hackman/solution.sw view
@@ -3,7 +3,7 @@ def tryGrab =     try {         grab;-        return ();+        pure ();     } {};     end; @@ -12,7 +12,7 @@     if hasPowerup {         r <- meet;         case r-            (\_. return ())+            (\_. pure ())             (\r. give r thing; wait 10);     } {};     end;
data/scenarios/Challenges/_hackman/teleport_monitor.sw view
@@ -12,7 +12,9 @@ def go = \lastBasePos.     wait 1;     curBasePos <- getBasePos;-    let deltaX = abs(fst curBasePos - fst lastBasePos) in+    match curBasePos \curx. \_.+    match lastBasePos \lastx. \_.+    let deltaX = abs (curx - lastx) in     if (deltaX > 1) {         create "bit (0)";     } {go curBasePos};
data/scenarios/Challenges/_hanoi/hanoi-count.sw view
@@ -9,7 +9,7 @@  def cscan = \d.   s <- scan d;-  if (s == inl ()) {return 0} {return 1}+  if (s == inl ()) {pure 0} {pure 1} end;  def count_column =@@ -24,7 +24,7 @@   // wait 8;   // log (format k);   // wait 8;-  return (i + j + k)+  pure (i + j + k) end;  @@ -47,7 +47,7 @@         // log (format y);         // wait 8;         // log (format z);-        return $ i2e (x + y + z)+        pure $ i2e (x + y + z)     };     //let sum = i2e (x + y + z) in     teleport self (0,-6);@@ -57,6 +57,6 @@     case counted (\e.         fail $ "Fatal error: there should always be a count entity at (0,-6)! " ++ format e ++ " " ++ format counted     ) (\e.-        if (e == sum) {} {swap sum; return ()}+        if (e == sum) {} {swap sum; pure ()}     ) }
data/scenarios/Challenges/_hanoi/hanoi-increasing.sw view
@@ -24,8 +24,9 @@ end;  w <- whereami;+match w \wx. \wy. // the middle of the column-let a = (fst w, snd w + 3) in+let a = (wx, wy + 3) in repeat (     o <- as self {         teleport self a;@@ -34,15 +35,15 @@         z <- scan north;         if (z == null) {           if (y == null) {-            return true+            pure true           } {-            return $ f x y+            pure $ f x y           }         } {-          return $ f x y && f y z+          pure $ f x y && f y z         }     };     try {-        if o {place "OK"} {grab; return ()}+        if o {place "OK"} {grab; pure ()}     } {} )
data/scenarios/Challenges/_hanoi/hanoi-invariant.sw view
@@ -10,7 +10,7 @@  repeat ( me <- scan down;-case me (\_. return ()) (\e.+case me (\_. pure ()) (\e. // if //  0. I stand on unlocked X //  1. place north of me is NOT empty@@ -25,13 +25,13 @@       case mn (\_.         teleport self (0,-6);         allPlaced <- ishere "three";-        return (not allPlaced)+        pure (not allPlaced)       ) (\_.-        return true+        pure true       );     };     if northFullOrAllPlaced {-      swap ("blocked " ++ e); return ()+      swap ("blocked " ++ e); pure ()     } {} } // if@@ -56,9 +56,9 @@         o2 <- ishere "OK";         teleport self (2,-5);         o3 <- ishere "OK";-        return (o1 && o2 && o3)+        pure (o1 && o2 && o3)       };-      if (allPlaced && allSorted) {swap (unlock e); return ()} {}-    ) (\_. return ())+      if (allPlaced && allSorted) {swap (unlock e); pure ()} {}+    ) (\_. pure ()) } ))
data/scenarios/Challenges/_hanoi/hanoi-solution.sw view
@@ -4,12 +4,12 @@ def ifC = \p. \t. \e. res <- p; if res t e end;  def orC = \c1. \c2.-  b1 <- c1; b2 <- c2; return (b1 || b2)+  b1 <- c1; b2 <- c2; pure (b1 || b2) end;  def somethingHere =   res <- scan down;-  return (res != inl ())+  pure (res != inl ()) end;  def fwdToThing = until blocked move end;@@ -26,7 +26,7 @@   fwdToThing;   d <- grab;   goBack;-  return d+  pure d end;  def placeDisk = \d.@@ -49,7 +49,7 @@   Int -> // The offset to third column   Cmd Int   = \n. \o. \a. \b. \c.-  if (n == 0) {return o}+  if (n == 0) {pure o}   {     o_new <- hanoi (n-1) o a c b;     moveToCol o_new a;
data/scenarios/Challenges/_ice-cream/customer.sw view
@@ -11,13 +11,13 @@     scoopCountExtra <- random 4000;     let scoopCount = 1000 + scoopCountExtra in     say $ format scoopCount ++ " scoops of vanilla ice cream, no more, no less! And top it with a cherry, please.";-    return scoopCount;+    pure scoopCount;     end;  def waitForItem = \item.     hasItem <- has item;     if hasItem {-        return ();+        pure ();     } {         wait 1;         waitForItem item;
data/scenarios/Challenges/_ice-cream/solution.sw view
@@ -30,12 +30,12 @@     move;     move;     turn right;-    return (cone, cherry);+    pure (cone, cherry);     end;  def meetCustomer =     maybeCustomer <- meet;-    case maybeCustomer (\_. meetCustomer) return;+    case maybeCustomer (\_. meetCustomer) pure;     end;  def serveScoop = \customer.@@ -55,11 +55,10 @@ def runSolution = \targetRemainingIngredientCount.     getBriefcase;     coneAndCherry <- getIngredients;+    match coneAndCherry \cone. \cherry.     getCounter;     customer <- meetCustomer; -    let cone = fst coneAndCherry in-    let cherry = snd coneAndCherry in     serveCustomer cone customer;     scoopUntil customer targetRemainingIngredientCount;     give customer cherry;
data/scenarios/Challenges/_lights-out/assistant.sw view
@@ -24,18 +24,20 @@     } {};     end; -def sumTuples = \t1. \t2.-    (fst t1 + fst t2, snd t1 + snd t2);-    end;+def λmatch = \f. \p. match p f end -def mapTuple = \f. \t.-    (f $ fst t, f $ snd t)+def sumTuples =+    λmatch \t11. \t12.+    λmatch \t21. \t22.+    (t11 + t21, t12 + t22);     end; +def mapTuple = \f. λmatch \a. \b. (f a, f b) end;+ def replaceWith = \withThis.     create withThis;     swap withThis;-    return ();+    pure ();     end;  /** Modifies the cell */@@ -49,7 +51,7 @@  def toggleLightHere =     entHere <- scan down;-    case entHere return invertLight;+    case entHere pure invertLight;     end;  /** Precondition: in the middle of a "cross" */@@ -79,7 +81,7 @@ def togglePending = \state.     let pendingEntityName = "pending-" ++ state in     maybePending <- detect pendingEntityName ((1, 1), (6, 6));-    case maybePending return $ flipSelfAndNeighbors state;+    case maybePending pure $ flipSelfAndNeighbors state;     end;  def observe =@@ -134,15 +136,16 @@  def advanceRowViaTeleport =     curLoc <- whereami;-    teleport self (0, snd curLoc - 1);+    match curLoc \_. \y.+    teleport self (0, y - 1);     end;  def shouldCorrectTile : (Bool * Bool) -> (Bool * Bool) -> Cmd Bool = \evenOverlaps. \isQuietTiles.     if (evenOverlaps == isQuietTiles) {         toggleLightHere;-        return true;+        pure true;     } {-        return false;+        pure false;     }     end; @@ -161,18 +164,18 @@          shouldAbort <- abortFunc quietTuple;         if shouldAbort {-            return ((0, 0), true);+            pure ((0, 0), true);         } {             let quietCellOn = mapTuple (\x. x && isCurrentlyOn) quietTuple in             let addend = mapTuple boolToInt quietCellOn in              move;             retval <- prepareBoardRow abortFunc rowIdx $ colIdx - 1;-            let subTotal = fst retval in-            return $ (sumTuples addend subTotal, snd retval);+            match retval \subTotal. \b.+            pure (sumTuples addend subTotal, b);         }     } {-        return ((0, 0), false);+        pure ((0, 0), false);     }     end; @@ -182,25 +185,24 @@ def prepareBoardAllRows = \abortFunc. \boardWidth. \rowIdx.     if (rowIdx >= 0) {         retval <- prepareBoardRow abortFunc rowIdx $ boardWidth - 1;-        let rowCommonCount = fst retval in-        let shouldAbort = snd retval in+        match retval \rowCommonCount. \shouldAbort.          if shouldAbort {-            return (0, 0);+            pure (0, 0);         } {             advanceRowViaTeleport;             totalCommonCount <- prepareBoardAllRows abortFunc boardWidth $ rowIdx - 1;-            return $ sumTuples rowCommonCount totalCommonCount+            pure $ sumTuples rowCommonCount totalCommonCount         }     } {-        return (0, 0);+        pure (0, 0);     }     end;  def checkIsSolvable = \boardWidth. \boardHeight.-    overlapCounts <- prepareBoardAllRows (\_. return false) boardWidth $ boardHeight - 1;+    overlapCounts <- prepareBoardAllRows (\_. pure false) boardWidth $ boardHeight - 1;     // say $ "Overlap counts: " ++ format overlapCounts;-    return $ mapTuple isEven overlapCounts;+    pure $ mapTuple isEven overlapCounts;     end;  /** Teleports to a new location to execute a function@@ -212,7 +214,7 @@     teleport self newLoc;     retval <- f;     teleport self prevLoc;-    return retval;+    pure retval;     end;  def analyzeSolvability : Int -> Int -> Cmd (Bool * Bool) = \boardWidth. \boardHeight.@@ -227,12 +229,13 @@     end;  def ensureSolvability = \evenOverlaps. \boardWidth. \boardHeight.-    let isSolvable = fst evenOverlaps && snd evenOverlaps in+    match evenOverlaps \a. \b.+    let isSolvable = a && b in     // say $ "isSolvable: " ++ format isSolvable;     if isSolvable {} {         atLocation (0, 0) $             prepareBoardAllRows (shouldCorrectTile $ mapTuple not evenOverlaps) boardWidth $ boardHeight - 1;-        return ()+        pure ()     }     end;
data/scenarios/Challenges/_lights-out/solution.sw view
@@ -12,7 +12,7 @@ /** Precondition: facing "d" direction */ def toggleToDark = \d.     onHere <- ishere "on";-    if onHere {drill d; return ()} {};+    if onHere {drill d; pure ()} {};     end;  def visitSingleRow = \rowWidth. \d.@@ -48,7 +48,7 @@  def onInDirection = \d.     entHere <- scan d;-    return $ case entHere (\_. false) (\e. e == "on");+    pure $ case entHere (\_. false) (\e. e == "on");     end;  /**
data/scenarios/Challenges/_maypole/monitor.sw view
@@ -6,6 +6,8 @@   i - m * (i / m) end +def λmatch = \f. \p. match p f end+ /* Quadrants are numbered counter-clockwise, staring in the northeast:         |@@ -17,12 +19,9 @@ This is same as the standard graph quadrants in mathematics, except for 0-based numbering rather than 1-based. */-def getQuadrant : (Int * Int) -> (Int * Int) -> Int = \baseLoc. \myLoc.-    let baseX = fst baseLoc in-    let baseY = snd baseLoc in--    let myX = fst myLoc in-    let myY = snd myLoc in+def getQuadrant : (Int * Int) -> (Int * Int) -> Int =+    λmatch \baseX. \baseY.+    λmatch \myX. \myY.      let isUp = myY < baseY in     let isRight = myX < baseX in@@ -55,7 +54,7 @@  def getCurrentQuadrant : (Int * Int) -> Cmd Int = \myLoc.   baseLoc <- as base {whereami};-  return $ getQuadrant baseLoc myLoc;+  pure $ getQuadrant baseLoc myLoc;   end;  def checkNewQuadrant = \myLoc. \prevQuadrant. \quadrantTraversalCount.@@ -65,9 +64,9 @@    if (changeCount != 0) {     swap $ "maypole " ++ format currentQuadrant;-    return ();+    pure ();   } {};-  return (currentQuadrant, newQuadrantCount);+  pure (currentQuadrant, newQuadrantCount);   end;  /*@@ -83,15 +82,14 @@ def monitorAngle : (Int * Int) -> Int -> Int -> Int -> Cmd Unit =     \myLoc. \targetQuadrantCount. \prevQuadrant. \quadrantTraversalCount.   result <- instant $ checkNewQuadrant myLoc prevQuadrant quadrantTraversalCount;-  let currentQuadrant = fst result in-  let newQuadrantCount = snd result in+  match result \currentQuadrant. \newQuadrantCount.    if (newQuadrantCount < targetQuadrantCount) {     monitorAngle myLoc targetQuadrantCount currentQuadrant newQuadrantCount;   } {     create "dizzy";     swap "bitcoin";-    return ();+    pure ();   }   end;
+ data/scenarios/Challenges/_telephone/judge.sw view
@@ -0,0 +1,82 @@+def forever: ∀ a b. {Cmd a} -> Cmd b = \c. force c; forever c end++def x : Int -> Cmd a -> Cmd Unit = \n. \c.+  if (n == 0) {} {c; x (n-1) c}+end++def andC : Cmd Bool -> Cmd Bool -> Cmd Bool = \c1. \c2.+  b1 <- c1;+  if b1 {c2} {pure false}+end++tydef List a = rec l. Unit + a * l end++def for : Int -> (Int -> Cmd a) -> Cmd (List a) = \n. \k.+  if (n == 0)+    { pure $ inl () }+    { x <- k (n-1);+      xs <- for (n-1) k;+      pure (inr (x,xs))+    }+end++def readRow : Cmd (List (Unit + Text)) =+  r <- for 8 (\_. s <- scan down; move; pure s);+  turn back; x 8 move; turn right; move; turn right;+  pure r+end++tydef Rect = List (List (Unit + Text)) end++def readRect : Cmd Rect =+  lst <- for 4 (\_. readRow);+  turn right; x 4 move; turn left;+  pure lst+end++def checkCell : Unit + Text -> Cmd Bool = \pat.+  actual <- scan down;+  move;+  pure (actual == pat)+end++def λmatch = \f. \p. match p f end+def λcase = \f. \g. \s. case s f g end++def checkRow : List (Unit + Text) -> Cmd Bool = λcase+  (\_. turn back; x 8 move; turn right; move; turn right; pure true)+  (λmatch \hd. \tl. andC (checkCell hd) (checkRow tl))+end++def checkRect : Rect -> Cmd Bool = λcase+  (\_. pure true)+  (λmatch \hd. \tl. andC (checkRow hd) (checkRect tl))+end++def check : Rect -> Cmd Unit = \rect.+  log "check!";+  origLoc <- whereami;+  teleport self (53, -8);+  b <- checkRect rect;+  if b {create "X"} {};+  teleport self origLoc; turn east;+end++def judge =+  instant (+    loc <- whereami;+    match loc \locx. \locy.+    for 4 (\y.+      for 8 (\x.+        surveil (locx + x, locy + y)+      )+    );+  );+  wait 1024;+  instant (+    rect <- readRect;+    check rect;+  )+end++forever {judge};
+ data/scenarios/Challenges/_telephone/photocopier.sw view
@@ -0,0 +1,32 @@+def forever: ∀ a b. {Cmd a} -> Cmd b = \c. force c; forever c end++def X : Int -> Cmd Unit -> Cmd Unit = \n. \c.+  if (n == 0) {} {c; X (n-1) c}+end++def pixel : (Int * Int) * Text -> Cmd Unit = \instr.+  match instr \loc. \ty.+  match loc \x. \y.+  turn back; X 5 move; turn right; X 2 move;+  turn west; X x move; turn north; X y move;+  place ty;+  turn south; X y move; turn east; X x move;+  X 5 move; turn right; X 2 move; turn east+end++def followInstructions : Text -> Cmd Unit = \paper.+  try {+    let res = read @((Int * Int) * Text) paper+    in  pixel res+  } {}+end++def copy : Cmd Unit =+  watch down; wait 1024;+  p <- atomic (b <- isempty; if b {pure ""} {grab});+  if (p == "") {} {followInstructions p}+end++def go = forever {copy} end++go;
+ data/scenarios/Challenges/_telephone/shuttle.sw view
@@ -0,0 +1,47 @@+def ifC: ∀ a. Cmd Bool -> {Cmd a} -> {Cmd a} -> Cmd a+  = \test. \then. \else.+  b <- test;+  if b then else+end++def while: ∀ a. Cmd Bool -> {Cmd a} -> Cmd Unit+  = \test. \body.+  ifC test {force body; while test body} {}+end++def forever: ∀ a b. {Cmd a} -> Cmd b = \c. force c; forever c end++def notC : Cmd Bool -> Cmd Bool = \c.+  b <- c; pure (not b)+end++def or : Cmd Bool -> Cmd Bool -> Cmd Bool = \c1. \c2.+  ifC c1 {pure true} {c2}+end++def followTrack : Cmd Unit =+  move;+  while (or (isHere "track") (isHere "mountain")) { move };+  turn back;+end++def pickup : Cmd Text =+  atomic (b <- isempty; if b {pure ""} {grab});+end++def dropoff : Text -> Cmd Bool = \thing.+  atomic (b <- isempty; if b {place thing} {}; pure b)+end++def deliver : Text -> Cmd Unit = \thing.+  move;+  followTrack;+  if (thing == "") {}+  {+    while (notC (dropoff thing)) { followTrack; followTrack }+  };+end++def go = forever {followTrack; thing <- pickup; deliver thing} end++go;
+ data/scenarios/Challenges/_telephone/solution.sw view
@@ -0,0 +1,77 @@+def x : Int -> Cmd a -> Cmd Unit = \n. \c.+  if (n == 0) {} {c; x (n-1) c}+end++def ifC: ∀ a. Cmd Bool -> {Cmd a} -> {Cmd a} -> Cmd a+  = \test. \then. \else.+  b <- test;+  if b then else+end++def while: ∀ a. Cmd Bool -> {Cmd a} -> Cmd Unit+  = \test. \body.+  ifC test {force body; while test body} {}+end++def for : Int -> (Int -> Cmd a) -> Cmd Unit = \n. \k.+  if (n == 0) {} {k n; for (n-1) k}+end++def harvestMay =+  e <- isempty;+  if e {} {harvest; pure ()}+end++def harvestTrees =+  turn back; move; turn left; x 5 move;+  turn left;+  x 5 (x 10 (harvestMay; move); turn back; x 10 move; turn left; move; turn left);+  turn left; x 10 move; turn right; move+end++def getWater =+  turn back; x 3 move; turn left; move;+  x 32 grab;+  turn back; move; turn right; x 3 move+end++def getPaper =+  harvestTrees;+  while (has "tree") {make "log"};+  x 2 (make "board"); make "boat"; equip "boat";+  getWater; x 4 (make "paper")+end++def scanAt : Int -> Int -> Cmd (Unit + Text) = \h. \v.+  x h move; turn right; x v move;+  s <- scan down;+  turn back; x v move; turn left; x h move; turn back;+  pure s+end++def atTerminal : Cmd a -> Cmd a = \c.+  x 12 move; turn left; x 2 move;+  a <- c;+  turn back; x 2 move; turn right; x 12 move; turn back;+  pure a+end++def waitToPlace : Text -> Cmd Unit = \t.+  success <- atomic (b <- isempty; if b {place t} {}; pure b);+  if success {} { watch down; wait 1024; waitToPlace t }+end++def go =+  getPaper;+  x 2 move; turn left; x 4 move;+  for 8 (\h.+    for 4 (\v.+      res <- scanAt (h-1) (v-1);+      case res+        (\_. pure ())+        (\t. atTerminal (p <- print "paper" (format ((h-1,v-1),t)); waitToPlace p))+    )+  )+end++go;
data/scenarios/Challenges/_wolf-goat-cabbage/multi-item-possession.sw view
@@ -1,4 +1,4 @@ has_wolf <- has "wolf"; has_goat <- has "goat"; has_cabbage <- has "cabbage";-return $ (has_wolf && has_goat) || (has_goat && has_cabbage) || (has_wolf && has_cabbage);+pure $ (has_wolf && has_goat) || (has_goat && has_cabbage) || (has_wolf && has_cabbage);
data/scenarios/Challenges/_wolf-goat-cabbage/together-on-east-bank.sw view
@@ -1,7 +1,8 @@ def get_x_coord = \r.     as r {         pos <- whereami;-        return $ fst pos;+        match pos \x. \_.+        pure x     };     end; @@ -10,16 +11,16 @@     thisX <- get_x_coord r;      as r {-        try {grab; return ()} {};+        try {grab; pure ()} {};         move;-        try {grab; return ()} {};+        try {grab; pure ()} {};         move;-        try {grab; return ()} {};+        try {grab; pure ()} {};          has_wolf <- has "wolf";         has_goat <- has "goat";         has_cabbage <- has "cabbage";-        return $ baseX == thisX && has_wolf && has_goat && has_cabbage;+        pure $ baseX == thisX && has_wolf && has_goat && has_cabbage;     };     end;
data/scenarios/Challenges/_wolf-goat-cabbage/unattended-together.sw view
@@ -1,7 +1,8 @@ def get_x_coord = \r.     as r {         pos <- whereami;-        return $ fst pos;+        match pos \x. \_.+        pure x;     };     end; @@ -10,20 +11,20 @@     thisX <- get_x_coord r;      if (baseX == thisX) {-        return false;+        pure false;     } {         as r {-            try {grab; return ()} {};+            try {grab; pure ()} {};             move;-            try {grab; return ()} {};+            try {grab; pure ()} {};             move;-            try {grab; return ()} {};+            try {grab; pure ()} {};              has_wolf <- has "wolf";             has_goat <- has "goat";             has_cabbage <- has "cabbage";-            return $ (has_wolf && has_goat) || (has_goat && has_cabbage);-        };        +            pure $ (has_wolf && has_goat) || (has_goat && has_cabbage);+        };     }     end; @@ -32,4 +33,4 @@ west_bad <- is_unattended_together baseX "west_detector"; east_bad <- is_unattended_together baseX "east_detector"; -return $ west_bad || east_bad;+pure $ west_bad || east_bad;
data/scenarios/Challenges/_word-search/create-puzzle.sw view
@@ -11,15 +11,15 @@  def whichOrdinal = \str.     if (str == "capital C") {-        return 0;+        pure 0;     } {         if (str == "capital O") {-            return 1;+            pure 1;         } {             if (str == "capital W") {-                return 2;+                pure 2;             } {-                return (-1);+                pure (-1);             }         }     }@@ -30,7 +30,7 @@ */ def getAdjacentOrdinal = \d.     maybeEntity <- scan d;-    str <- case maybeEntity (\_. return "") (\s. return s);+    str <- case maybeEntity (\_. pure "") (\s. pure s);     whichOrdinal str;     end; @@ -48,12 +48,12 @@  def chooseLetter = \i.     if (i == 0) {-        return "capital C";+        pure "capital C";     } {         if (i == 1) {-            return "capital O";+            pure "capital O";         } {-            return "capital W";+            pure "capital W";         }     };     end;@@ -68,21 +68,22 @@     northOrdinal <- getAdjacentOrdinal north;     if (northOrdinal == 1) {         currentLoc <- whereami;-        teleport self (fst currentLoc, snd currentLoc + 1);+        match currentLoc \x. \y.+        teleport self (x, y + 1);         doubleNorthOrdinal <- getAdjacentOrdinal north;         teleport self currentLoc;          if (doubleNorthOrdinal == 2) {-            return 0;+            pure 0;         } {             if (doubleNorthOrdinal == 0) {-                return 2;+                pure 2;             } {-                return (-1);+                pure (-1);             }         }     } {-        return (-1);+        pure (-1);     }     end; @@ -106,18 +107,18 @@      if excludeZero {         if (excludedVertical == 2) {-            return 1;+            pure 1;         } {             // Zero is the only excluded value,             // so just offset a choice between 0 and 1 upward by 1,              // to make it a choice between 1 and 2.             val <- random 2;-            return $ val + 1;+            pure $ val + 1;         };     } {         if excludeTwo {             if (excludedVertical == 0) {-                return 1;+                pure 1;             } {                 // Two is the only excluded value,                 // so make it a choice between 0 and 1.@@ -129,7 +130,7 @@                 // so just offset a choice between 0 and 1 upward by 1,                  // to make it a choice between 1 and 2.                 val <- random 2;-                return $ val + 1;+                pure $ val + 1;             } {                 if (excludedVertical == 2) {                     // Two is the only excluded value,@@ -150,12 +151,13 @@     letterIndex <- reRoll excludedVertical expectedFwdOrdinal expectedBkwdOrdinal;     chosenLetter <- chooseLetter letterIndex;     place chosenLetter;-    return letterIndex;+    pure letterIndex;     end;  def crossBack = \_n.     currentLoc <- whereami;-    teleport self (0, snd currentLoc - 1);+    match currentLoc \_. \y.+    teleport self (0, y - 1);     end;  /**@@ -169,15 +171,15 @@         move;          newFwdOrdinal <- if (placedIndex == expectedFwdOrdinal || placedIndex == 0) {-            return $ placedIndex + 1;+            pure $ placedIndex + 1;         } {-            return 0;+            pure 0;         };          newBkwdOrdinal <- if (placedIndex == expectedBkwdOrdinal || placedIndex == 2) {-            return $ placedIndex - 1;+            pure $ placedIndex - 1;         } {-            return 2;+            pure 2;         };          layTilesRow newFwdOrdinal newBkwdOrdinal $ n - 1;@@ -191,7 +193,8 @@  def removeBoulder =     baseLoc <- as base {whereami};-    teleport self (fst baseLoc - 1, snd baseLoc);+    match baseLoc \x. \y.+    teleport self (x - 1, y);      // Remove the boulder blocking the player's path     grab;
data/scenarios/Challenges/_word-search/solution.sw view
@@ -20,17 +20,17 @@ def whichOrdinal =     isC <- ishere "capital C";     if (isC) {-        return 0;+        pure 0;     } {         isO <- ishere "capital O";         if (isO) {-            return 1;+            pure 1;         } {             isW <- ishere "capital W";             if (isW) {-                return 2;+                pure 2;             } {-                return (-1);+                pure (-1);             }         }     }@@ -39,9 +39,10 @@ // Go to upper-left corner def goToCorner =     myLoc <- whereami;-    doN (fst myLoc) move;+    match myLoc \x. \y.+    doN x move;     turn right;-    doN (-(snd myLoc)) move;+    doN (-y) move;     turn right;     end; @@ -57,23 +58,23 @@     // considered a "match".     let shouldAdvance = theFoundOrdinal == expectedOrdinal || theFoundOrdinal == 0 in     newExpectedOrdinal <- if shouldAdvance {-        return $ theFoundOrdinal + 1;+        pure $ theFoundOrdinal + 1;     } {         // Reset the progress-        return 0;+        pure 0;     };      if (newExpectedOrdinal == 3) {         turn back;          intersperse 3 move highlightLetter;-        return true;+        pure true;     } {         if (colCount > 1) {             move;             traverseRow newExpectedOrdinal (colCount - 1);         } {-          return false;+          pure false;         };     };     end;@@ -92,18 +93,18 @@ def traverseCols = \width. \height.      didWin <- traverseRow 0 width;     if didWin {-        return true;+        pure true;     } {         turn back;         didWinBackward <- traverseRow 0 width;         if didWinBackward {-            return true;+            pure true;         } {             if (height > 1) {                 advanceRow;                 traverseCols width $ height - 1;             } {-                return false;+                pure false;             };         }     } @@ -115,7 +116,7 @@      wonHorizontally <- traverseCols boardWidth boardHeight;     if wonHorizontally {-        return true;+        pure true;     } {         // If we did not find a horizontal solution,         // look for vertical solutions.
data/scenarios/Challenges/arbitrage.yaml view
@@ -20,7 +20,7 @@     condition: |       as base {         pcount <- count "paperclip";-        return $ pcount >= 100;+        pure $ pcount >= 100;       };   - teaser: Beginner capital     goal:@@ -32,7 +32,7 @@     condition: |       as base {         pcount <- count "paperclip";-        return $ pcount >= 20;+        pure $ pcount >= 20;       }; attrs:   - name: shopA@@ -381,7 +381,6 @@   dsl: |     {dirt}   upperleft: [0, 0]-  offset: false   palette:     '.': [grass]     '*': [stone]
data/scenarios/Challenges/blender.yaml view
@@ -28,12 +28,12 @@           let basename = "base" in           x <- as r {whoami};           if (x == basename) {-              return false;+              pure false;           } {               mr0 <- as r {meet};               case mr0-                (\_. return false)-                (\bot. name <- as bot {whoami}; return $ name == basename);+                (\_. pure false)+                (\bot. name <- as bot {whoami}; pure $ name == basename);           };           end; @@ -52,11 +52,11 @@               let foo = intermediate in               let newIdx = idx + 1 in               recursiveResult <- anyHasMetBase newIdx;-              return $ foo || recursiveResult;+              pure $ foo || recursiveResult;           } {             // Terminates the recursion on the             // lowest index at which a robot does not exist-            return false;+            pure false;           };           end; @@ -193,7 +193,6 @@   dsl: |     {stone, water}   upperleft: [0, 0]-  offset: false   palette:     '0': [stone, water]     '@': [stone, granite boulder]
data/scenarios/Challenges/bridge-building.yaml view
@@ -71,8 +71,8 @@     condition: |       as base {         c <- whereami;-        let x = fst c in-        return $ x >= 1 && x <= 2 && snd c == -30;+        match c \x. \y.+        pure $ x >= 1 && x <= 2 && y == -30;       };   - id: get_pebble     teaser: Off-piste
data/scenarios/Challenges/bucket-brigade.yaml view
@@ -79,6 +79,27 @@ solution: |   run "scenarios/Challenges/_bucket-brigade/brigade.sw" entities:+  - name: upper left corner+    display:+      attr: entity+      char: '┌'+    description:+      - Upper left corner.+    properties: [unwalkable, known]+  - name: upper right corner+    display:+      attr: entity+      char: '┐'+    description:+      - An upper right corner wall.+    properties: [unwalkable, known]+  - name: vertical wall+    display:+      attr: entity+      char: '│'+    description:+      - A vertical wall.+    properties: [unwalkable, known]   - name: bucketwheel excavator     display:       char: 'x'@@ -123,6 +144,12 @@     description:       - Kit that can be unpacked into everything a robot needs to reproduce.     properties: [known, pickable]+  - name: wall+    display:+      char: '#'+    description:+      - Unmovable barrier+    properties: [known, unwalkable, boundary] recipes:   - in:       - [1, repro kit]@@ -185,13 +212,11 @@     'H': [stone, null, hauler]     'Z': [stone, null, powerplant]     'w': [grass]+    'x': [stone, wall]     's': [stone]     'A': [stone, boulder]     '┌': [stone, upper left corner]     '┐': [stone, upper right corner]-    '└': [stone, lower left corner]-    '┘': [stone, lower right corner]-    '─': [stone, horizontal wall]     '│': [stone, vertical wall]   upperleft: [0, 0]   map: |-@@ -203,11 +228,11 @@     ..AA......................     ...A..A...............┌┐..     ..A.................┌┐││..-    .....A.............┌────┐.-    ...................│sZss│.-    .A.................└────┘.+    .....A.............xxxxxx.+    ...................xsZssx.+    .A.................xxxxxx.     .....A......B==========H=.     ..........................-    .............┌┐.┌──────┐..-    w......A.....└┘.└──────┘..+    .............xx.xxxxxxxx..+    w......A.....xx.xxxxxxxx..     ww........................
data/scenarios/Challenges/chess_horse.yaml view
@@ -12,8 +12,8 @@         bloc <- as base {whereami};         king <- robotNamed "king";         kloc <- as king {whereami};-        return (bloc == kloc)-      } { return false }+        pure (bloc == kloc)+      } { pure false } solution: |   move; move; move; turn right; move; turn left; move; robots:@@ -31,6 +31,13 @@     dir: [0, 0]     display:       char: '♚'+entities:+  - name: wall+    display:+      char: '#'+    description:+      - Unmovable barrier+    properties: [known, unwalkable, boundary] known: [water] world:   dsl: |@@ -38,21 +45,16 @@   palette:     '.': [grass, erase]     '#': [ice, erase]-    '┌': [stone, upper left corner]-    '┐': [stone, upper right corner]-    '└': [stone, lower left corner]-    '┘': [stone, lower right corner]-    '─': [stone, horizontal wall]-    '│': [stone, vertical wall]+    'w': [stone, wall]   upperleft: [-1, 1]   map: |-    ┌────────┐-    │.#.#.#.#│-    │#.#.#.#.│-    │.#.#.#.#│-    │#.#.#.#.│-    │.#.#.#.#│-    │#.#.#.#.│-    │.#.#.#.#│-    │#.#.#.#.│-    └────────┘+    wwwwwwwwww+    w.#.#.#.#w+    w#.#.#.#.w+    w.#.#.#.#w+    w#.#.#.#.w+    w.#.#.#.#w+    w#.#.#.#.w+    w.#.#.#.#w+    w#.#.#.#.w+    wwwwwwwwww
data/scenarios/Challenges/combo-lock.yaml view
@@ -106,7 +106,6 @@   dsl: |     {water}   upperleft: [-1, -1]-  offset: false   palette:     '.': [grass, erase]     '$': [grass, bitcoin]
data/scenarios/Challenges/dimsum.yaml view
@@ -12,10 +12,14 @@       p <- robotnamed "patron";       as p {         foodCount <- count "food";-        return $ foodCount >= 2;+        pure $ foodCount >= 2;       } solution: |   run "scenarios/Challenges/_dimsum/solution.sw"+attrs:+  - name: barrier+    fg: "#222222"+    bg: "#111111" robots:   - name: base     dir: [1, 0]@@ -73,6 +77,13 @@     program: |       run "scenarios/Challenges/_dimsum/patron.sw" entities:+  - name: wall+    display:+      attr: barrier+      char: '#'+    description:+      - Unmovable barrier+    properties: [known, unwalkable, boundary]   - name: table     display:       attr: wood@@ -134,7 +145,7 @@     'B': [grass, erase, base]     '.': [grass, erase]     'S': [dirt, erase]-    '@': [grass, boulder]+    '@': [grass, wall]     'd': [grass, table]     'k': [grass, table, cook]     'p': [grass, table, patron]
+ data/scenarios/Challenges/dna.yaml view
@@ -0,0 +1,597 @@+version: 1+name: DNA+author: Karl Ostmo+description: |+  Copy strands of DNA in the lab to replicate organisms+creative: false+seed: 9+attrs:+  - name: floorattr+    bg: "#111111"+  - name: wall2+    fg: "#88ee22"+  - name: pink+    fg: "#ff99bb"+  - name: lemon+    fg: "#eeee99"+  - name: clover+    bg: "#225522"+  - name: beige+    fg: "#f5f5dc"+  - name: soup+    fg: "#338822"+    bg: "#774422"+terrains:+  - name: floor+    attr: floorattr+    description: |+      Laboratory floor+objectives:+  - id: place_flower+    teaser: Place subject+    goal:+      - |+        The laboratory building ahead is neatly landscaped, though+        its decorative `pond`{=structure} exudes a peculiar quality.+        There may be a device you can `use` to sample its contents.++        The DNA lab has two large apparatus inside.+        The first is a `DNA sequencer`{=structure} that+        determines the arrangement of ATCG pairs within an `organism`{=tag}'s genome.++        The `DNA decoder`{=structure} in the lab's south wing can reconstitute+        an `organism`{=tag} from its genome.++        To get started, borrow a `dahlia`{=entity} from the flowerbed at the lab+        entrance and place it in the receptacle directly to your east.+    condition: |+      r <- robotnamed "lab";+      as r {+        has "pixel (G)";+      }+  - id: place_complements+    teaser: Complement strand+    prerequisite: place_flower+    goal:+      - |+        The `DNA sequencer`{=structure} will begin to decode the subject's DNA.+        The subject will be dematerialized once the top row+        of the "double helix" has been decoded.++        You must then complete the double helix (fill in the second row within the device)+        with complementary base pairs.+        Use your `soup strainer`{=entity} to obtain ingredients.+        Consult your *Compendium* for appropriate pairings.++        Note that `scan`ning has a cost, and you have a limited supply of+        `specimen slide`{=entity}s (in a `slide box`{=entity}) with which to+        `scan` DNA bases using your `microscope`{=entity}.+    condition: |+      r <- robotnamed "topchecker";+      as r {+        has "pixel (G)";+      }+  - id: create_clone+    prerequisite: place_complements+    teaser: Create clone+    goal:+      - |+        Now let's make a clone! Recreate the top half of the+        DNA strand in the south wing's `DNA decoder`{=structure}+        (you remember the sequence, right?).++        Each element you `place` will be automatically complemented.++        When all segments are placed, `drill` the switch on the western wall to+        commence rematerialization. `grab` the clone (once matured) as a souvenir!+    condition: |+      def λmatch = \f. \p. match p f end+      def λcase = \f. \g. \s. case s f g end++      def hasAll : (rec l. Unit + Text * l) -> Cmd Bool = λcase+        (\_. pure true)+        (λmatch \hd. \tl. b1 <- has hd; if b1 {hasAll tl} {pure false})+      end;++      k <- robotnamed "keeper";+      as k {+        let organisms = tagmembers "organism" in+        hasAll organisms;+      }+  - prerequisite: create_clone+    teaser: More clones+    goal:+      - |+        Toggle the switch off to reset the lab.+      - |+        Find three more different `organism`{=tag}s to clone.+        Explore outside nearby the lab for specimens.+    condition: |+      def λmatch = \f. \p. match p f end+      def λcase = \f. \g. \s. case s f g end++      def hasCount : (rec l. Unit + Text * l) -> Cmd Int = λcase+        (\_. pure 0)+        (λmatch \hd. \tl. b <- has hd; n <- hasCount tl; pure (if b {1} {0} + n))+      end;++      k <- robotnamed "keeper";+      as k {+        let organisms = tagmembers "organism" in+        c <- hasCount organisms;+        pure $ c >= 4;+      }+robots:+  - name: base+    dir: east+    loc: [-8, 4]+    devices:+      - antenna+      - ADT calculator+      - barcode reader+      - branch predictor+      - comparator+      - compass+      - dictionary+      - feeler+      - grabber+      - hearing aid+      - lambda+      - logger+      - microscope+      - rolex+      - siphon+      - soup strainer+      - strange loop+      - switch puller+      - treads+      - welder+      - workbench+    inventory:+      - [1, slide box]+  - name: lab+    system: true+    dir: east+    display:+      invisible: true+      attr: 'robot'+    devices:+      - switch puller+    inventory:+      - [1, branch predictor]+      - [1, treads]+      - [1, beaglepuss]+      - [1, antenna]+      - [1, comparator]+      - [1, clock]+      - [1, workbench]+      - [1, grabber]+      - [1, ADT calculator]+      - [1, dictionary]+      - [1, lambda]+      - [1, logger]+      - [1, welder]+      - [1, hearing aid]+      - [1, scanner]+      - [1, strange loop]+      - [1, solar panel]+    program: |+      run "data/scenarios/Challenges/_dna/lab.sw"+  - name: topchecker+    system: true+    dir: east+    display:+      invisible: true+      attr: 'robot'+    program: |+      run "data/scenarios/Challenges/_dna/topchecker.sw"+  - name: mirrorbot+    system: true+    dir: south+    display:+      invisible: true+      attr: 'robot'+    program: |+      run "data/scenarios/Challenges/_dna/mirrorbot.sw"+  - name: resetter+    description: resets the apparatus after completion by watching the switch+    system: true+    dir: east+    display:+      invisible: true+      attr: 'robot'+    program: |+      run "data/scenarios/Challenges/_dna/resetter.sw"+  - name: keeper+    description: keeps track of cloned specimens+    system: true+    dir: south+    display:+      invisible: true+      attr: 'robot'+solution: |+  run "data/scenarios/Challenges/_dna/solution.sw"+structures:+  - name: pond+    recognize:+      - north+    structure:+      mask: '.'+      palette:+        'x': [grass, rock]+        'w': [dirt, pond broth]+      map: |+        ...xxxxxxxx..+        ..xwwwwwwwwx.+        ..xwwwwwwwwwx+        ..xwwwwwwwwwx+        .xwwwwwwxxxx.+        xwwwwwwx.....+        xwwwwwwx.....+        .xxxxxx......+  - name: fairy ring+    structure:+      mask: '.'+      palette:+        'm': [grass, mushroom]+      map: |+        ....mm.m...+        ..m........+        .........m.+        ..m........+        ...m...m...+  - name: receptacle+    structure:+      mask: '.'+      palette:+        'x': [floor, wall]+        'w': [floor, wall2]+        'f':+          cell: [floor, erase]+          waypoint:+            name: receiver+      map: |+        ww........+        fwxxxxxxxx+        ww.x.x.x.x+  - name: decoder base+    structure:+      palette:+        '┬': [stone, down and horizontal wall]+        '┴': [stone, up and horizontal wall]+        ':': [floor, erase]+      map: |+        ┬┬┬┬┬┬┬┬┬┬┬┬┬┬┬┬┬┬┬┬┬┬┬┬┬┬┬┬┬┬┬┬+        ::::::::::::::::::::::::::::::::+        ::::::::::::::::::::::::::::::::+        ┴┴┴┴┴┴┴┴┴┴┴┴┴┴┴┴┴┴┴┴┴┴┴┴┴┴┴┴┴┴┴┴+  - name: copybots overlay+    structure:+      mask: '.'+      palette:+        'm': [floor, erase, mirrorbot]+      map: |+        ................................+        mmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmm+        ................................+        ................................+  - name: decoder overlay+    structure:+      mask: '.'+      palette:+        'c': [floor, erase, topchecker]+      map: |+        ................................+        ................................+        c...............................+        ................................+  - name: DNA decoder+    recognize:+      - north+    structure:+      placements:+        - src: decoder base+        - src: copybots overlay+        - src: receptacle+          offset: [18, -4]+          orient:+            up: south+      map: ""+  - name: DNA sequencer+    recognize:+      - north+    structure:+      placements:+        - src: decoder base+        - src: decoder overlay+        - src: receptacle+          offset: [4, 3]+      map: ""+entities:+  - name: down and horizontal wall+    display:+      attr: entity+      char: '┬'+    description:+      - A down and horizontal wall.+    properties: [unwalkable, known]+  - name: up and horizontal wall+    display:+      attr: entity+      char: '┴'+    description:+      - A up and horizontal wall.+    properties: [unwalkable, known]+  - name: barcode reader+    display:+      attr: red+      char: 'S'+    description:+      - Reads the 'tag' of an item+    properties: [pickable]+    capabilities: [hastag, tagmembers]+  - name: dahlia+    display:+      char: '*'+      attr: pink+    description:+      - Brightly colored flower+    properties: [known, pickable, growable]+    growth:+      duration: [20, 30]+    tags: [organism]+  - name: daisy+    display:+      char: 'x'+      attr: lemon+    description:+      - Pretty flower+    properties: [pickable, growable]+    growth:+      duration: [15, 30]+    tags: [organism]+  - name: clover+    display:+      char: 'c'+      attr: clover+    description:+      - A tiny, 3-leaf plant+    properties: [pickable, growable]+    growth:+      duration: [10, 20]+    tags: [organism]+  - name: mushroom+    display:+      char: 'm'+      attr: beige+    description:+      - Invasive fungus+    properties: [pickable, growable]+    growth:+      duration: [15, 25]+      spread:+        radius: 2+        density: 0.5+    biomes: [floor, stone]+    tags: [organism]+  - name: wall2+    display:+      char: 'w'+      attr: wall2+    description:+      - Just a wall+    properties: [known, unwalkable, boundary]+  - name: primordial soup+    display:+      char: 's'+      attr: soup+    description:+      - Can be decomposed into nucleic acids+    properties: [pickable, liquid]+  - name: pond broth+    display:+      char: 's'+      attr: soup+    description:+      - Can be decomposed into nucleic acids+    properties: [pickable, liquid]+  - name: soup strainer+    display:+      char: 'r'+    description:+      - Extracts nucleic acids from `primordial soup`{=entity}+    properties: [known, pickable]+  - name: feeler+    display:+      char: 'm'+    description:+      - Senses presence of specific entities+    properties: [known, pickable]+    capabilities: [blocked, ishere, isempty]+  - name: microscope+    display:+      char: 'm'+    description:+      - Scan for the cost of 1 `specimen slide`{=entity}+    properties: [known, pickable]+    capabilities:+      - capability: scan+        cost:+          - [1, "specimen slide"]+  - name: specimen slide+    display:+      char: 'i'+      attr: device+    description:+      - Can take a sample of DNA for scanning+  - name: slide box+    display:+      char: 'b'+      attr: device+    description:+      - Contains `specimen slides`{=entity}+  - name: guanine+    display:+      char: 'G'+      attr: red+    description:+      - One of the four nucleobases in DNA.+      - Is paired with `cytosine`{=entity}.+    properties: [known]+  - name: cytosine+    display:+      char: 'C'+      attr: blue+    description:+      - One of the four nucleobases in DNA.+      - Is paired with `guanine`{=entity}.+    properties: [known]+  - name: adenine+    display:+      char: 'A'+      attr: green+    description:+      - One of the four nucleobases in DNA.+      - Is paired with `thymine`{=entity}.+    properties: [known]+  - name: thymine+    display:+      char: 'T'+      attr: gold+    description:+      - One of the four nucleobases in DNA.+      - Is paired with `adenine`{=entity}.+    properties: [known]+  - name: switch (off)+    display:+      attr: red+      char: '•'+    description:+      - A control in the deactivated position.+    properties: [known]+  - name: switch (on)+    display:+      attr: green+      char: '•'+    description:+      - A control in the activated position.+    properties: [known]+  - name: organic sludge+    display:+      attr: green+      char: 'S'+    description:+      - A repulsive, shuddering mass of slime.+    properties: [pickable]+  - name: switch puller+    display:+      char: 'P'+      attr: gold+    capabilities: [drill]+    description:+      - Can pull switches+  - name: siphon+    display:+      char: 's'+      attr: device+    capabilities: [drill]+    description:+      - Can retrieve liquid+recipes:+  - in:+      - [1, slide box]+    out:+      - [32, specimen slide]+  - in:+      - [1, primordial soup]+    out:+      - [4, cytosine]+      - [4, guanine]+      - [4, adenine]+      - [4, thymine]+    required:+      - [1, soup strainer]+  - in:+      - [1, switch (off)]+    out:+      - [1, switch (on)]+    required:+      - [1, switch puller]+  - in:+      - [1, switch (on)]+    out:+      - [1, switch (off)]+    required:+      - [1, switch puller]+  - in:+      - [1, pond broth]+    out:+      - [8, primordial soup]+    required:+      - [1, siphon]+known: [flower, rock]+world:+  dsl: |+    let+      flowerNoise = perlin seed 1 0.15 0.0,+      soupNoise = perlin seed 2 0.04 1.0,++      flowers = flowerNoise > 0.70,+      soup = soupNoise > 0.9+    in+      overlay+      [ {grass}+      , mask (flowers && (x - y) % 3 == 0) {daisy}+      , mask soup {clover}+      ]+  upperleft: [-2, 4]+  mask: 'q'+  palette:+    'z': [stone, wall]+    '.': [stone, erase]+    'G':+      cell: [stone, erase]+    'o': [stone, erase]+    'd': [dirt, dahlia]+    'v': [stone, erase, lab, keeper]+    '0':+      cell: [stone, switch (off), resetter]+      waypoint:+        name: switch+    'D':+      structure:+        name: DNA decoder+      cell: [floor, erase]+    'E':+      structure:+        name: DNA sequencer+      cell: [floor, erase]+  placements:+    - src: pond+      offset: [-17, -10]+    - src: fairy ring+      offset: [-5, -25]+  map: |+    dzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz+    dzv.........................................z+    zzz........oo...............................z+    ............o...............................z+    zzz........oo...............................z+    dz.....Eooooooooooooooooooooooooooooooo.....z+    dz.....o..............................o.....z+    dz.....o..............................o.....z+    dz.....oooooooooooooooooooooooooooooooo.....z+    qz..........................................z+    qzzzzzzzzz.zzzzzzzzzzzzzzzzzzzzzzzz.zzzzzzzzz+    qqqqqqqqqzGzqqqqqqqqqqqqqqqqqqqqqqzGzqqqqqqqq+    qzzzzzzzzz.zzzzzzzzzzzzzzzzzzzzzzzz.zzzzzzzzz+    qz..........................................z+    qzz....D....................................z+    qz0.........................................z+    qzz.........................................z+    qz..........................................z+    qz..........................................z+    qz..........................................z+    qz..........................................z+    qz..........................................z+    qzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz
+ data/scenarios/Challenges/flower-count.yaml view
@@ -0,0 +1,177 @@+version: 1+name: Flower Count+author: Brent Yorgey+description: |+  Count the flowers quickly... or else!+creative: false+objectives:+  - id: count_flowers+    teaser: Count the flowers!+    goal:+      - |+        Your evil nemesis, the sadistic arithmomaniac supervillain Count Nemesis, is+        at it again!  They have wired up some explosives to your+        `True Love`{=robot} and lit the fuse, but promised to stop it... IF you can+        count all the flowers in time!+      - |+        Specifically, Count Nemesis demands that you count the+        total number of flowers in the 120x40 field bounded by walls,+        `print` the number on a piece of `paper`{=entity}, and place+        the paper at the origin, `(0,0)`.  If the number is correct,+        the countdown stops and your True Love is saved.  If the+        number is incorrect... nothing happens, but the fuse continues+        to burn!+      - |+        And watch out, Count Nemesis won't abide anyone picking his flowers.+    condition: |+      judge <- robotNamed "judge";+      as judge { has "gold" }+  - id: pick_flower+    hidden: true+    optional: true+    teaser: You just don't listen, do you+    goal:+      - |+        I told you not to pick any flowers!  Now your True Love is+        dead... because of YOU!+      - |+        Perhaps you would like to go back in time and try again.+    condition: |+      f <- as base { has "flower" };+      judge <- robotNamed "judge";+      g <- as judge { has "gold" };+      pure (not g && f)+  - id: out_of_time+    hidden: true+    optional: true+    teaser: Not fast enough+    goal:+      - |+        You were not fast enough, and now your True Love is+        dead... because of YOU!+      - |+        Perhaps you would like to go back in time and try again.+    condition: |+      truelove <- robotNamed "truelove";+      as truelove { b <- ishere "fuse"; pure (not b) }+  - id: joinpoint+    hidden: true+    teaser: Follow instructions!+    prerequisite:+      logic:+        and:+          - count_flowers+          - not: pick_flower+          - not: out_of_time+    condition: |+      pure true+  - id: win+    teaser: Give a flower+    prerequisite: joinpoint+    goal:+      - |+        Congratulations!  You foiled the plan of evil Dr. Nemesis and+        saved your True Love!  The only thing left is to give your+        True Love a `flower`{=entity}!+    condition: |+      truelove <- robotNamed "truelove";+      as truelove { has "flower" }+solution: |+  run "scenarios/Challenges/_flower-count/solution.sw"+robots:+  - name: base+    dir: north+    devices:+      - solar panel+      - treads+      - antenna+      - comparator+      - ADT calculator+      - workbench+      - grabber+      - dictionary+      - lambda+      - logger+      - welder+      - scanner+      - strange loop+      - typewriter+      - 3D printer+      - branch predictor+      - clock+      - GPS receiver+      - compass+      - counter+    inventory:+      - [12, solar panel]+      - [12, dictionary]+      - [12, lambda]+      - [12, treads]+      - [12, branch predictor]+      - [12, comparator]+      - [12, hyperloop]+      - [12, compass]+      - [12, scanner]+      - [12, logger]+      - [12, GPS receiver]+      - [12, string]+      - [12, typewriter]+      - [12, rubber band]+      - [12, grabber]+      - [12, parsley]+      - [1, paper]+  - name: igniter+    system: true+    dir: east+    devices:+      - logger+    program: 'ignite down'+  - name: judge+    system: true+    dir: east+    devices:+      - logger+    program: |+      run "scenarios/Challenges/_flower-count/judge.sw"+  - name: truelove+    system: true+    display:+      invisible: false+      attr: red+      char: '♥'+    description: Your One True Love.+attrs:+  - name: fuse+    fg: '#cccccc'+    bg: '#002f00'+entities:+  - name: fuse+    display:+      attr: fuse+      char: '-'+    description:+      - Slow-burning fuse+    properties: [combustible, known, boundary]+    combustion:+      ignition: 20+      duration: [64, 64]+      delay: 63+      product: ash+known: [flower, wall, ash]+world:+  dsl: |+    overlay+    [ if (hash % 7 <= 2) then {grass, flower} else {grass}+    , mask ((x == 61 || x == (-60)) && y <= 21 && y >= -20) {wall, stone}+    , mask ((y == 21 || y == (-20)) && x <= 61 && x >= -60) {wall, stone}+    ]+  upperleft: [0, 0]+  palette:+    'B': [grass, null, base]+    'J': [grass, erase, judge]+    '.': [grass]+    '-': [grass, fuse]+    'L': [grass, fuse, truelove]+    'I': [grass, fuse, igniter]+  map: |+    JB..I---------------L
data/scenarios/Challenges/friend.yaml view
@@ -63,7 +63,7 @@       c <- robotNamed "cat";       catLoc <- as c {whereami};       baseLoc <- as base {whereami};-      return (catLoc == baseLoc)+      pure (catLoc == baseLoc) solution: |   run "scenarios/Challenges/_friend/friend-solution.sw" entities:@@ -74,9 +74,8 @@       - A smelly fish. Rather unappetizing to a robot.     properties: [known, pickable] known: [fish]-seed: 0+seed: 1 world:-  offset: true   palette:     'Ω': [grass, null, base]     '.': [stone]
data/scenarios/Challenges/gallery.yaml view
@@ -51,27 +51,35 @@     condition: |       def ensureMonotonicDecreasing = \itemCount. \prevOrdinal.         maybeEntity <- scan down;-        case maybeEntity (\_. return $ itemCount == 0) (\item.+        case maybeEntity (\_. pure $ itemCount == 0) (\item.             myCount <- count item;             if (myCount <= prevOrdinal) {               move;               ensureMonotonicDecreasing (itemCount - 1) myCount;             } {-              return false;+              pure false;             };         );         end; +      def λmatch = \f. \p. match p f end+      def λcase = \f. \g. \s. case s f g end++      def length : (rec l. Unit + a * l) -> Int = λcase+        (\_. 0)+        (λmatch \_. \rest. 1 + length rest)+      end+       j <- robotnamed "judge";       as j {         // Flag that setup is done         hasBitcoin <- has "bitcoin";         if hasBitcoin {-          result <- tagmembers "bust" 0;-          let itemCount = fst result in-          ensureMonotonicDecreasing itemCount $ itemCount + 1;+          let busts = tagmembers "bust" in+          let bustCount = length busts in+          ensureMonotonicDecreasing bustCount $ bustCount + 1;         } {-          return false;+          pure false;         }       }; robots:@@ -245,7 +253,6 @@     , if (((3 - y) % 20)/11 + ((x + 3) % 20)/11) == 0 then {terrain: grass} else {blank}     ]   upperleft: [0, 11]-  offset: false   palette:     'B': [stone, null, base]     'j': [stone, null, judge]
data/scenarios/Challenges/gopher.yaml view
@@ -20,9 +20,9 @@     condition: |       try {         robotnamed "gopher";-        return false;+        pure false;       } {-        return true;+        pure true;       }   - teaser: Recover equipment     prerequisite: defeat_gopher@@ -34,7 +34,7 @@     condition: |       as base {         sCount <- count "scanner";-        return $ sCount >= 120;+        pure $ sCount >= 120;       } robots:   - name: base@@ -132,7 +132,6 @@   dsl: |     "classic"   upperleft: [-1, 1]-  offset: false   palette:     'x': [dirt, erase]     '.': [grass, erase]
data/scenarios/Challenges/hackman.yaml view
@@ -29,7 +29,7 @@       as base {         pcount <- count "pellet";         donut_count <- count "donut";-        return $ pcount >= 181;+        pure $ pcount >= 181;       };   - id: donut_given     teaser: Give to ghost@@ -47,12 +47,12 @@           };            if hasPowerup {-              return true;+              pure true;           } {               if (n > 1) {                   anyHasPowerup $ n - 1;               } {-                  return false;+                  pure false;               }           }           end;@@ -68,7 +68,7 @@       loc <- as base {         whereami;       };-      return $ loc == (0, 0);+      pure $ loc == (0, 0);   - teaser: World wrap     hidden: true     optional: true@@ -109,10 +109,10 @@               if (n > 1) {                   allHasPowerup $ n - 1;               } {-                  return true;+                  pure true;               }           } {-              return false;+              pure false;           }           end; @@ -277,12 +277,7 @@     'x': [blank, wall]     'T': [blank, null, teleport_monitor]     '=': [blank, gate]-    '┌': [stone, upper left corner]-    '┐': [stone, upper right corner]-    '└': [stone, lower left corner]-    '┘': [stone, lower right corner]-    '─': [stone, horizontal wall]-    '│': [stone, vertical wall]+    '+': [stone, wall]     'W':       cell: [blank]       waypoint:@@ -317,9 +312,9 @@     Bx.....x....x....x.....xB     Bxxxxx.xxxxBxBxxxx.xxxxxB     BBBBBx.xBBBBBBBBBx.xBBBBB-    Bxxxxx.xB┌──=──┐Bx.xxxxxB-    ZYBBBB.BB│abBcd│BB.BBBBWX-    Bxxxxx.xB└─────┘Bx.xxxxxB+    Bxxxxx.xB+++=+++Bx.xxxxxB+    ZYBBBB.BB+abBcd+BB.BBBBWX+    Bxxxxx.xB+++++++Bx.xxxxxB     BBBBBx.xBBBfΩBBBBx.xBBBBB     Bxxxxx.xBxxxxxxxBx.xxxxxB     Bx..........x..........xB
data/scenarios/Challenges/hanoi.yaml view
@@ -13,7 +13,7 @@       y <- ishere "blocked two";       teleport self (2,-3);       z <- ishere "blocked three";-      return (x && y && z)+      pure (x && y && z) solution: |   run "scenarios/Challenges/_hanoi/hanoi-solution.sw" robots:@@ -143,6 +143,12 @@       attr: gold     description:       - This entity signals that the column is sorted.+  - name: wall+    display:+      char: '#'+    description:+      - Unmovable barrier+    properties: [known, unwalkable, boundary] known:   - bottom tee   - OK@@ -159,26 +165,20 @@     ',': [grass]     '_': [stone]     'v': [stone, null, base]-    '┌': [stone, upper left corner]-    '┐': [stone, upper right corner]-    '└': [stone, lower left corner]-    '┘': [stone, lower right corner]-    '─': [stone, horizontal wall]-    '│': [stone, vertical wall]-    '┴': [stone, bottom tee]     '1': [stone, one, invariant]     '2': [stone, blocked two, invariant]     '3': [stone, blocked three, invariant]     '.': [stone, null, invariant]     '^': [grass, null, increasing]     'X': [grass, three, count]+    'w': [stone, wall]   upperleft: [-3, 1]   map: |-    ┌─────┐-    │__v__│-    │1│.│.│-    │2│.│.│-    │3│.│.│-    └─┴─┴─┘+    wwwwwww+    w__v__w+    w1w.w.w+    w2w.w.w+    w3w.w.w+    wwwwwww     ,^,^,^,     ,,,X,,,
data/scenarios/Challenges/ice-cream.yaml view
@@ -195,6 +195,12 @@     description:       - Decoration     properties: [known]+  - name: wall+    display:+      char: '#'+    description:+      - Unmovable barrier+    properties: [known, unwalkable, boundary] recipes:   - in:       - [1, egg]@@ -209,7 +215,6 @@   dsl: |     {grass}   upperleft: [0, 0]-  offset: false   palette:     '.': [grass]     ':': [stone]@@ -220,12 +225,7 @@     X: [stone, null, customer]     'y': [stone, awning1]     'z': [stone, awning2]-    '┌': [stone, upper left corner]-    '┐': [stone, upper right corner]-    '└': [stone, lower left corner]-    '┘': [stone, lower right corner]-    '─': [stone, horizontal wall]-    '│': [stone, vertical wall]+    'w': [stone, wall]     '\': [stone, cone left]     '/': [stone, cone right]     'Z': [stone, cone inside]@@ -239,6 +239,6 @@     ...:..........     ...:.......OO.     yzy:yzyz..OOOO-    ┌─┐x┌──┐..^^^^-    │B:Ω:V6│..\ZZ/-    └──────┘...\/.+    wwwxwwww..^^^^+    wB:Ω:V6w..\ZZ/+    wwwwwwww...\/.
data/scenarios/Challenges/lights-out.yaml view
@@ -20,20 +20,21 @@     condition: |       def advanceRow =           curLoc <- whereami;-          teleport self (0, snd curLoc - 1);+          match curLoc \_. \y.+          teleport self (0, y - 1);           end;        def isRowDark = \n.           if (n > 0) {               onHere <- ishere "on";               if onHere {-                  return false;+                  pure false;               } {                   move;                   isRowDark $ n - 1;               }           } {-              return true;+              pure true;           }           end; @@ -44,10 +45,10 @@                   advanceRow;                   areAllOff rowWidth $ n - 1;               } {-                  return false;+                  pure false;               }           } {-              return true;+              pure true;           }           end; @@ -57,7 +58,7 @@               teleport self (0, 0);               turn east;               areAllOff 5 5;-          } {return false};+          } {pure false};           end;        j <- robotnamed "judge";@@ -144,7 +145,6 @@ known: [] world:   upperleft: [-1, 1]-  offset: false   palette:     B: [blank, null, base]     z: [blank, null, judge]
data/scenarios/Challenges/maypole.yaml view
@@ -103,7 +103,6 @@   dsl: |     {grass}   upperleft: [0, 0]-  offset: false   palette:     'B': [grass, null, base]     '.': [grass]
data/scenarios/Challenges/pack-tetrominoes.yaml view
@@ -21,8 +21,8 @@         Place all five tetrominoes.     condition: |       def found = \s.-        fs <- structure s 0;-        return $ case fs (\_. false) (\_. true);+        fs <- structures s;+        pure $ case fs (\_. false) (\_. true);         end;        foundT <- found "tee";@@ -30,7 +30,7 @@       foundI <- found "line";       foundZ <- found "zee";       foundQ <- found "square";-      return $ foundT && foundJ && foundI && foundZ && foundQ;+      pure $ foundT && foundJ && foundI && foundZ && foundQ; robots:   - name: base     dir: east
+ data/scenarios/Challenges/telephone.yaml view
@@ -0,0 +1,222 @@+version: 1+name: Telephone+author: Brent Yorgey+description: |+  Give another robot instructions to duplicate a pattern.+creative: false+objectives:+  - id: 'paper'+    teaser: Make some paper+    goal:+      - |+        As part of a scheme to prove your intelligence to anyone+        watching from space, the mystical geoglyph of X's and O's in the+        blue square needs to be copied into the square across the+        mountains.+      - |+        One small problem is that the mountains are too high for you+        to cross! However, there is a shuttle service, running on a+        regular schedule through a tunnel, that can deliver small+        packages to the terminal on the other side of the mountains.+        At the other terminal is a general-purpose utility robot; you+        will have to send it instructions so it can recreate the+        design for you.+      - |+        As a first step, you will need `paper`{=entity} on which to+        write the instructions; make at least 8 sheets of+        `paper`{=entity}.+    condition: |+      as base {+        pcount <- count "paper";+        pure $ pcount >= 8;+      };+  - teaser: Duplicate the design+    prerequisite: 'paper'+    goal:+      - |+        Now that you have some `paper`{=entity}, you can use your+        `typewriter`{=entity} to `print` on it. If you `format` a+        value, `print` it on some paper, and send it via the shuttle,+        the utility robot will be able to read the value.+      - |+        In particular, the utility robot is expecting to read values+        of type `(Int * Int) * Text`{=type}, where the+        `(Int * Int)`{=type} tuple is an x- and y-offset from the lower right+        corner of the blue box, and the `Text`{=type} is the name of+        the entity (either `X`{=entity} or `O`{=entity}) to place+        there.  For example, if you printed `((3,1), "O")` then the+        utility robot would place an `O`{=entity} 3 units to the left+        and 1 unit above the bottom-right corner of the blue square.+      - |+        To send something via the shuttle, just place the item you+        wish to send on the purple cell at the center of the eastern+        terminal, that is, the cell with coordinates `(88, -10)`.  The+        next time the shuttle arrives, it will notice the item and+        pick it up for delivery.+    condition: |+      judge <- robotNamed "judge";+      as judge { has "X" }+solution: |+  run "scenarios/Challenges/_telephone/solution.sw"+robots:+  - name: base+    dir: north+    devices:+      - branch predictor+      - treads+      - antenna+      - comparator+      - ADT calculator+      - workbench+      - harvester+      - dictionary+      - lambda+      - logger+      - welder+      - scanner+      - strange loop+      - solar panel+      - string+      - typewriter+      - rolex+      - rubber band+      - tweezers+    inventory: []+  - name: shuttle+    system: true+    dir: east+    display:+      invisible: false+      char: 'Ξ'+      priority: 8+    program: |+      run "scenarios/Challenges/_telephone/shuttle.sw"+  - name: photocopier+    system: true+    dir: east+    display:+      invisible: false+      char: '*'+    inventory:+      - [100, 'O']+      - [100, 'X']+    program: |+      run "scenarios/Challenges/_telephone/photocopier.sw"+  - name: judge+    system: true+    dir: east+    devices:+      - logger+    program: |+      run "scenarios/Challenges/_telephone/judge.sw"+attrs:+  - name: greyborder+    fg: '#cccccc'+    bg: '#002f00'+  - name: blueborder+    fg: '#4287f5'+    bg: '#002f00'+  - name: purpleborder+    fg: '#d885ff'+    bg: '#002f00'+  - name: purplebg+    bg: '#d885ff'+  - name: yg+    fg: '#ffff8f'+    bg: '#002f00'+  - name: rg+    fg: '#ff8f8f'+    bg: '#002f00'+entities:+  - name: mountain+    display:+      attr: snow+      char: 'A'+      priority: 9+    description:+      - An impassably tall mountain.+    properties: [unwalkable, opaque]+  - name: blueborder+    display:+      char: '%'+      attr: 'blueborder'+    description:+      - Decorative border+    properties: [known, boundary]+  - name: purpleborder+    display:+      char: '&'+      attr: 'purpleborder'+    description:+      - Decorative border+    properties: [known, boundary]+  - name: track+    display:+      char: '='+      attr: entity+    description:+      - Narrow-gauge track.+    properties: [known]+  - name: O+    display:+      char: 'O'+      attr: rg+    description:+      - O+    properties: [known]+  - name: X+    display:+      char: 'X'+      attr: yg+    description:+      - X+    properties: [known]+terrains:+  - name: terminal+    attr: purplebg+    description: Shuttle terminal+known: [mountain, tree, water, wavy water]+world:+  dsl: |+    overlay+    [ {grass}+    , if (x >= 53 && x <= 60 && y >= -8 && y <= -5) then+        (if (hash % 7 <= 1) then {X} else if (hash % 7 <= 3) then {O} else {grass})+        else {grass}+    ]+  upperleft: [0, 0]+  palette:+    '.': [grass]+    '#': [grass, wall]+    '%': [grass, blueborder]+    'A': [stone, mountain]+    'T': [grass, tree]+    'W': [stone, water]+    '~': [stone, wavy water]+    '^': [grass, null, base]+    '&': [grass, purpleborder]+    '=': [grass, track]+    'S': [grass, track, shuttle]+    'P': [grass, null, photocopier]+    'J': [grass, null, judge]+    't': [terminal]+  map: |+    ################################################################################+    #..............................AA..............................................#+    #.............................AAA......................................T.......#+    #............................AAA......................................TT.......#+    #....%%%%%%%%%%...............AAAA..................%%%%%%%%%%.........TTT.....#+    #....%........%................AAAAA................%........%.......TTT.......#+    #....%........%...................AA................%........%.....TTTT........#+    #....%........%...............AAAAA.................%........%.......TTT.......#+    #....%J.......%..............AAA....................%........%.........T.......#+    #....%%%%%%%%%%..&&&........AAAAA..............&&&..%%%%%%%%%%.......TTTT......#+    #................&P===========AA========S=======t&..............^.....TTTT.....#+    #................&&&.........AAAA..............&&&.....................TT......#+    #..............................AAA.............................................#+    #...............................AAAA.............................WWW...........#+    #..............................AAAAAA............................WW~W..........#+    #...............................AAAA...........................WW~WW...........#+    #..............................AAAA..............................WW............#+    #.............................AAA..............................................#+    ################################################################################
data/scenarios/Challenges/teleport.yaml view
@@ -11,7 +11,7 @@     condition: |       try {         as base {has "lambda"}-      } { return false }+      } { pure false } solution: |   def w2 = turn back; turn back end;   def w10 = w2; w2; w2; w2; w2 end;@@ -54,6 +54,13 @@         basePos <- as base {whereami};         if (myPos == basePos) {teleport base destPos} {};       );+entities:+  - name: wall+    display:+      char: '#'+    description:+      - Unmovable barrier+    properties: [known, unwalkable, boundary] known: [water, wavy water, flower, tree] world:   dsl: |@@ -66,19 +73,14 @@     'T': [grass, tree]     '.': [grass, erase]     '_': [stone, erase]-    '┌': [stone, upper left corner]-    '┐': [stone, upper right corner]-    '└': [stone, lower left corner]-    '┘': [stone, lower right corner]-    '─': [stone, horizontal wall]-    '│': [stone, vertical wall]     'λ': [grass, lambda]+    'x': [stone, wall]   upperleft: [-1, 3]   map: |     ~~   ~         ~    ~-    ~┌─────┐~  ┌─────┐~ ,-    ┌┘.....└───┘T...*└┐ ~-    │_....._   _..λ.._│ ,-    └┐.....┌───┐*...T┌┘ ~-    ~└─────┘ ~~└─────┘~ ,+    ~xxxxxxx~  xxxxxxx~ ,+    xx.....xxxxxT...*xx ~+    x_....._   _..λ.._x ,+    xx.....xxxxx*...Txx ~+    ~xxxxxxx ~~xxxxxxx~ ,     ~~~   ~        ~    ~
data/scenarios/Challenges/wave.yaml view
@@ -21,7 +21,7 @@       - |         The robots caught you!     condition: |-      as base {x <- meet; return $ case x (\_. false) (\_. true)};+      as base {x <- meet; pure $ case x (\_. false) (\_. true)}; robots:   - name: base     dir: north@@ -56,7 +56,8 @@           end;       def start =           pos <- whereami;-          wait $ fst pos;+          match pos \x. \_.+          wait x;           go;           end;       start;@@ -71,7 +72,6 @@     , if (x / 2 - y) % 5 == 0 then {dirt, wavy water} else {blank}     ]   upperleft: [-3, 6]-  offset: false   palette:     'B': [grass, erase, base]     'w': [grass, erase, wavebot]
data/scenarios/Challenges/word-search.yaml view
@@ -14,8 +14,8 @@         or vertically in either the upward or downward direction.         Diagonal appearances are not valid.     condition: |-      foundStructure <- structure "cow" 0;-      return $ case foundStructure (\_. false) (\_. true);+      foundStructures <- structures "cow";+      pure $ case foundStructures (\_. false) (\_. true); robots:   - name: base     display:@@ -178,7 +178,6 @@   dsl: |     {dirt}   upperleft: [0, 0]-  offset: false   palette:     '@': [stone, boulder]     '.': [grass]
data/scenarios/Fun/00-ORDER.txt view
@@ -2,3 +2,4 @@ logo-burst.yaml horton.yaml snake.yaml+spider.yaml
data/scenarios/Fun/GoL.yaml view
@@ -33,7 +33,7 @@         h <- scan down;         f <- scan forward;         b <- scan back;-        return (cnt h + cnt f + cnt b)+        pure (cnt h + cnt f + cnt b)       end;       def mod : Int -> Int -> Int = \a. \b. a - (a/b)*b end;       def waitUntil = \p.@@ -42,20 +42,20 @@       end;       forever (         h <- scan down;-        alive <- return (h != inl ());+        alive <- pure (h != inl ());         n1 <- count3;         turn left; move; turn right; n2 <- count3;         turn right; move; move; turn left; n3 <- count3;         turn left; move; turn right;-        total <- return (n1 + n2 + n3 - if alive {1} {0});+        total <- pure (n1 + n2 + n3 - if alive {1} {0});         if (alive && (total < 2 || total > 3))-          { grab; return () }+          { grab; pure () }           { if (not alive && total == 3)             { place "rock" }             {}           };         // synchronize-        waitUntil (t <- time; return (mod t 0x20 == 0))+        waitUntil (t <- time; pure (mod t 0x20 == 0))       ) world:   dsl: |
data/scenarios/Fun/_logo-burst/drone.sw view
@@ -8,7 +8,7 @@  def randdir : Cmd Dir =   d <- random 4;-  return (+  pure (     if (d == 0) {north}     $ elif (d == 1) {east}     $ elif (d == 2) {south}@@ -33,9 +33,10 @@   end;  def converge = \loc. \currentLoc.--  let xDist = fst currentLoc - fst loc in-  let yDist = snd currentLoc - snd loc in+  match loc \x. \y.+  match currentLoc \curx. \cury.+  let xDist = curx - x in+  let yDist = cury - y in    if (xDist < 0) {     turn east;
data/scenarios/Fun/_snake/snake.sw view
@@ -2,8 +2,10 @@ Uses a string to maintain a queue of coordinates. */ -def coordsToString : (Int * Int) -> Text = \coords.-  format (fst coords) ++ "," ++ format (snd coords)+def λmatch = \f. \p. match p f end++def coordsToString : (Int * Int) -> Text = λmatch \x. \y.+  format x ++ "," ++ format y   end  def indexOfRec : Int -> Text -> Text -> (Unit + Int) = \pos. \inputString. \targetChar.@@ -24,17 +26,19 @@  // Drops the first character of a string def strTail : Text -> Text = \inputString.-  snd $ split 1 inputString+  match (split 1 inputString) \_. \rest. rest   end  def splitOnFirstChar : Text -> Text -> (Text * Text) = \inputString. \splitChar.-  case (indexOf inputString splitChar) (\_.-    // Did not find the split character, so return the original string-    (inputString, "")-  ) (\foundIdx.-    let parts = split foundIdx inputString in-    (fst parts, strTail $ snd parts)-  )+  case (indexOf inputString splitChar)+    (\_.+      // Did not find the split character, so return the original string+      (inputString, "")+    )+    (\foundIdx.+      match (split foundIdx inputString) \a. \b.+      (a, strTail b)+    )   end  def getDecimalCharValue = \inputString. \idx.@@ -58,8 +62,8 @@  // Comma (",") is the separator between abscissa and ordinate def stringToCoords : Text -> (Int * Int) = \coordsString.-  let pair = splitOnFirstChar coordsString "," in-  (parseDecimal $ fst pair, parseDecimal $ snd pair)+  match (splitOnFirstChar coordsString ",") \a. \b.+  (parseDecimal a, parseDecimal b)   end  // APPEND to string representation of a coordinate list@@ -72,7 +76,8 @@ def pop : Text -> (Unit + ((Int * Int) * Text)) = \strList.   if (chars strList > 0) {     let pair = splitOnFirstChar strList ";" in-    inR (stringToCoords $ fst pair, snd pair)+    match pair \a. \b.+    inR (stringToCoords a, b)   } {     inL ();   }@@ -86,7 +91,7 @@   teleport self targetLoc;   x <- func;   teleport self currLoc;-  return x;+  pure x;   end;  def moveTail = \tailList.@@ -95,20 +100,17 @@     let maybeShifted = pop tailList in     case maybeShifted (\_.       // Nothing to pick up or replace-      return tailList;--    ) (\newPair.+      pure tailList; -        let farthestTail = fst newPair in-        let newInit = snd newPair in+    ) (λmatch \farthestTail. \newInit.         newLoc <- whereami;         grabbedItem <- doAtLoc newLoc farthestTail grab;         place grabbedItem; -        return $ snoc newLoc newInit;+        pure $ snoc newLoc newInit;     );   } {-    return tailList;+    pure tailList;   }   end; @@ -119,11 +121,11 @@     targetLoc <- as r {whereami};      maybeD <- getDir targetLoc;-    case maybeD (\_. say "Dead!"; return "") (\d.-      turn $ fst d;+    case maybeD (\_. say "Dead!"; pure "") (λmatch \dir. \_.+      turn dir;       newList <- moveTail tailList;       move;-      return newList+      pure newList     );     end @@ -139,10 +141,10 @@     modifiedTailList <- try {       make "tail";       swap "tail";-      return $ snoc myLoc tailList;+      pure $ snoc myLoc tailList;     } {       grab;-      return tailList;+      pure tailList;     };     // Need to move here so that we get out of the way     // if the tail gets elongated
+ data/scenarios/Fun/_spider/spider.sw view
@@ -0,0 +1,62 @@+def doN = \n. \f. if (n > 0) {f; doN (n - 1) f} {}; end;++def intersperse = \n. \f2. \f1. if (n > 0) {+        f1;+        if (n > 1) {+            f2;+        } {};+        intersperse (n - 1) f2 f1;+    } {};+    end;++def placeBoulder =  \border.+    create border;++    isEmptyHere <- isempty;+    if isEmptyHere {+        place border+    } {+        swap border;+        pure ();+    };+    +    pure ();+end++def spinWeb = \border.+    move;+    turn left;++    try {+        intersperse 2 move $ placeBoulder border;+        doN 3 (+            turn left;+            doN 2 (placeBoulder border; move);+        );+        placeBoulder border;+    } {};+end++def goDir = \result.+    match result \d. \_.+    if (d == down) {+        spinWeb "mountain";+    } {+        turn d; move;+    };+end;++def followRoute = \item.+    nextDir <- path (inL ()) (inR item);+    case nextDir pure goDir;+    followRoute item;+    end;++myname <- whoami;+let target_object = if (myname == "tree spider") {+    "tree";+} {+    "flower"+} in++followRoute target_object;
data/scenarios/Fun/horton.yaml view
@@ -12,7 +12,7 @@     condition: |       as base {         flowerCount <- count "flower";-        return $ flowerCount >= 399;+        pure $ flowerCount >= 399;       } robots:   - name: Horton@@ -35,13 +35,13 @@       - wayfinder solution: |   def goDir = \f. \result.-    let d = fst result in+    match result \d. \_.     if (d == down) {grab; f;} {turn d; move; f;}     end;    def followRoute =       nextDir <- path (inL ()) (inR "flower");-      case nextDir return $ goDir followRoute;+      case nextDir pure $ goDir followRoute;       end;    followRoute;@@ -79,7 +79,6 @@       , mask (x < -80 || x > 80 || y < -60 || y > 60) (overlay [{water}])       ]   upperleft: [-4, 4]-  offset: false   palette:     'B': [grass, erase, Horton]     '.': [grass, erase]
data/scenarios/Fun/logo-burst.yaml view
@@ -56,7 +56,6 @@ known: [boulder, tree, water, wavy water] world:   upperleft: [0, 0]-  offset: false   palette:     'Ω': [blank, null, base]     's': [blank, null, stoplight]
data/scenarios/Fun/snake.yaml view
@@ -13,7 +13,7 @@       r <- robotnamed "snake";       as r {         appleCoreCount <- count "apple core";-        return $ appleCoreCount >= 40;+        pure $ appleCoreCount >= 40;       } robots:   - name: base
+ data/scenarios/Fun/spider.yaml view
@@ -0,0 +1,57 @@+version: 1+name: Spiders+description: |+  Spiders catching prey by spinning webs+creative: true+objectives:+  - goal:+      - |+        Complete 10 `cocoon`{=structure}s+    condition: |+      def length : (rec l. Unit + a * l) -> Int = \l.+        case l (\_. 0) (\cons. match cons \_. \tl. 1 + length tl)+      end++      foundStructures <- structures "cocoon";+      pure $ length foundStructures >= 10;+robots:+  - name: base+    dir: north+    loc: [5, 0]+  - name: ground spider+    display:+      invisible: false+      attr: blue+    dir: north+    system: true+    loc: [0, 0]+    program: |+      run "scenarios/Fun/_spider/spider.sw"+  - name: tree spider+    display:+      invisible: false+      attr: red+    dir: north+    system: true+    loc: [0, 0]+    program: |+      run "scenarios/Fun/_spider/spider.sw"+structures:+  - name: cocoon+    recognize: [north]+    structure:+      mask: '.'+      palette:+        'b': [grass, mountain]+      map: |+        bbb+        b.b+        bbb+known: [tree]+world:+  dsl: |-+    overlay+      [ {grass}+      , mask ((hash % 200) == 0) {flower}+      , mask (((hash+1) % 200) == 0) {tree}+      ]
data/scenarios/Speedruns/curry.yaml view
@@ -34,7 +34,6 @@       - [50, clock]       - [5, toolkit] world:-  offset: true   scrollable: false   dsl: |     "classic"
data/scenarios/Speedruns/forester.yaml view
@@ -5,7 +5,7 @@ objectives:   - goal:       - Harvest 1024 `tree`{=entity}s as quickly as possible!-    condition: as base {n <- count "tree"; return (n >= 1024)}+    condition: as base {n <- count "tree"; pure (n >= 1024)} robots:   - name: base     loc: [0, 0]@@ -34,7 +34,6 @@       - [50, clock]       - [5, toolkit] world:-  offset: true   scrollable: false   dsl: |     "classic"
data/scenarios/Speedruns/mithril.yaml view
@@ -34,7 +34,6 @@       - [50, clock]       - [5, toolkit] world:-  offset: true   scrollable: false   dsl: |     "classic"
data/scenarios/Testing/00-ORDER.txt view
@@ -36,6 +36,7 @@ 1218-stride-command.yaml 1234-push-command.yaml 1256-halt-command.yaml+1271-wall-boundaries.yaml 1262-display-device-commands.yaml 1295-density-command.yaml 1138-structures@@ -56,6 +57,7 @@ 1721-walkability-whitelist-path-cache.yaml 1535-ping 1575-structure-recognizer+1592-shared-template-robot-say-logs.yaml 1631-tags.yaml 1634-message-colors.yaml 1681-pushable-entity.yaml@@ -67,3 +69,9 @@ 1533-sow-command.yaml 1533-sow-seed-maturation.yaml 231-requirements+2085-toplevel-mask.yaml+2086-structure-palette.yaml+2239-custom-entity.yaml+2240-overridden-entity-capabilities.yaml+2253-halt-waiting.yaml+2270-instant-defs.yaml
data/scenarios/Testing/1024-sand.yaml view
@@ -6,7 +6,7 @@   https://github.com/swarm-game/swarm/pull/1024 objectives:   - condition: |-      as base {n <- count "sand"; return (n >= 32)}+      as base {n <- count "sand"; pure (n >= 32)}     goal:       - Obtain 32 sand. solution: |
data/scenarios/Testing/1034-custom-attributes.yaml view
@@ -61,7 +61,8 @@       - Do nothing     condition: |       pos <- as base {whereami};-      return $ fst pos > 7;+      match pos \x. \_.+      pure $ x > 7; entities:   - name: color1     display:
data/scenarios/Testing/1138-structures/flip-and-rotate.yaml view
@@ -11,12 +11,7 @@   palette:     '.': [grass]     '*': [stone, flower]-    '┌': [stone, upper left corner]-    '┐': [stone, upper right corner]-    '└': [stone, lower left corner]-    '┘': [stone, lower right corner]-    '─': [stone, horizontal wall]-    '│': [stone, vertical wall]+    '+': [stone, wall]   upperleft: [-1, 1]   structures:     - name: tetromino@@ -68,20 +63,20 @@         up: west         flip: true   map: |-    ┌──────────────────────────────┐-    │*..*..*..*..*..*..*..*..*..*..│-    │.*..*..*..*..*..*..*..*..*..*.│-    │..*..*..*..*..*..*..*..*..*..*│-    │*..*..*..*..*..*..*..*..*..*..│-    │.*..*..*..*..*..*..*..*..*..*.│-    │..*..*..*..*..*..*..*..*..*..*│-    │*..*..*..*..*..*..*..*..*..*..│-    │.*..*..*..*..*..*..*..*..*..*.│-    │..*..*..*..*..*..*..*..*..*..*│-    │*..*..*..*..*..*..*..*..*..*..│-    │.*..*..*..*..*..*..*..*..*..*.│-    │..*..*..*..*..*..*..*..*..*..*│-    │*..*..*..*..*..*..*..*..*..*..│-    │.*..*..*..*..*..*..*..*..*..*.│-    │..*..*..*..*..*..*..*..*..*..*│-    └──────────────────────────────┘+    +++++++++++++++++++++++++++++++++    +*..*..*..*..*..*..*..*..*..*..++    +.*..*..*..*..*..*..*..*..*..*.++    +..*..*..*..*..*..*..*..*..*..*++    +*..*..*..*..*..*..*..*..*..*..++    +.*..*..*..*..*..*..*..*..*..*.++    +..*..*..*..*..*..*..*..*..*..*++    +*..*..*..*..*..*..*..*..*..*..++    +.*..*..*..*..*..*..*..*..*..*.++    +..*..*..*..*..*..*..*..*..*..*++    +*..*..*..*..*..*..*..*..*..*..++    +.*..*..*..*..*..*..*..*..*..*.++    +..*..*..*..*..*..*..*..*..*..*++    +*..*..*..*..*..*..*..*..*..*..++    +.*..*..*..*..*..*..*..*..*..*.++    +..*..*..*..*..*..*..*..*..*..*++    ++++++++++++++++++++++++++++++++
data/scenarios/Testing/1138-structures/nested-structure.yaml view
@@ -11,22 +11,9 @@   palette:     '.': [grass]     '*': [stone, flower]-    '┌': [stone, upper left corner]-    '┐': [stone, upper right corner]-    '└': [stone, lower left corner]-    '┘': [stone, lower right corner]-    '─': [stone, horizontal wall]-    '│': [stone, vertical wall]+    '+': [stone, wall]   upperleft: [-1, 1]   structures:-    - name: bitpair-      structure:-        palette:-          '0': [stone, bit (0)]-          '1': [stone, bit (1)]-        map: |-          1-          0     - name: bigbox       structure:         palette:@@ -37,16 +24,13 @@             structure:               palette:                 '.': [stone]-                '┌': [stone, upper left corner]-                '┐': [stone, upper right corner]-                '└': [stone, lower left corner]-                '┘': [stone, lower right corner]+                '+': [stone, wall]               placements:                 - src: bitpair                   offset: [1, 0]               map: |-                ┌.┐-                └.┘+                +.++                +.+         placements:           - src: minibox             offset: [0, -1]@@ -57,6 +41,14 @@           T.T.T.           .T.T.T           TTTTTT+    - name: bitpair+      structure:+        palette:+          '0': [stone, bit (0)]+          '1': [stone, bit (1)]+        map: |+          1+          0   placements:     - src: bigbox       offset: [1, -1]@@ -69,13 +61,13 @@     - src: bitpair       offset: [3, -7]   map: |-    ┌────────────┐-    │*..*..*..*..│-    │.*..*..*..*.│-    │..*..*..*..*│-    │*..*..*..*..│-    │.*..*..*..*.│-    │..*..*..*..*│-    │*..*..*..*..│-    │.*..*..*..*.│-    └────────────┘+    +++++++++++++++    +*..*..*..*..++    +.*..*..*..*.++    +..*..*..*..*++    +*..*..*..*..++    +.*..*..*..*.++    +..*..*..*..*++    +*..*..*..*..++    +.*..*..*..*.++    ++++++++++++++
data/scenarios/Testing/1140-detect-command.yaml view
@@ -10,15 +10,13 @@ solution: |   def doN = \n. \f. if (n > 0) {f; doN (n - 1) f} {}; end;   loc <- detect "tree" ((0, 0), (6, 4));-  case loc return (\delta.-    let xDelta = fst delta in-    let yDelta = snd delta in+  case loc pure (\delta. match delta \xDelta. \yDelta.     if (yDelta < 0) {turn south;} {};     doN yDelta move; // y-movement     if (xDelta < 0) {turn west;} {turn east};     doN xDelta move; // x-movement     grab;-    return ();+    pure ();   ); robots:   - name: base
data/scenarios/Testing/1157-drill-return-value.yaml view
@@ -8,7 +8,7 @@       as base {ishere "gumball"}; solution: |   out <- drill forward;-  case out return place;+  case out pure place; robots:   - name: base     dir: north
data/scenarios/Testing/1171-resonate-command.yaml view
@@ -9,7 +9,7 @@       j <- robotnamed "judge";       as j {         c <- resonate "tree" ((0, 0), (8, -2));-        return $ c >= 7;+        pure $ c >= 7;       }; solution: |   def doN = \n. \f. if (n > 0) {f; doN (n - 1) f} {}; end;
data/scenarios/Testing/1171-sniff-command.yaml view
@@ -16,9 +16,9 @@         turn back;         move;         turn left;-        return oldDistance;+        pure oldDistance;       } {-        return newDistance;+        pure newDistance;       };       homeIn item d;     } {
data/scenarios/Testing/1218-stride-command.yaml view
@@ -26,7 +26,7 @@   try {     stride 5;     grab;-    return ();+    pure ();   } {     log "Could not grab northern flower";   };@@ -42,7 +42,7 @@   try {     stride 5;     grab;-    return ();+    pure ();   } {     log "Could not grab southern flower";   };@@ -75,7 +75,7 @@     description:       - Allows one to "stride" across multiple cells     properties: [known, pickable]-    capabilities: [movemultiple]+    capabilities: [stride] known: [tree, flower, boulder, water] world:   palette:
data/scenarios/Testing/1256-halt-command.yaml view
@@ -9,7 +9,7 @@       as base {has "flower"} solution: |   mr <- meet;-  case mr (\_. return ()) (\r. halt r; turn west; move; salvage )+  case mr (\_. pure ()) (\r. halt r; turn west; move; salvage ) robots:   - name: base     dir: south
+ data/scenarios/Testing/1271-wall-boundaries.yaml view
@@ -0,0 +1,96 @@+version: 1+name: Wall boundary display+creative: false+description: |+  Demonstrate rendering of contiguous boundaries.++  Only adjacent with the 'boundary' property+  will be rendered with box border glyphs.+attrs:+  - name: purpleWall+    fg: '#ff00ff'+  - name: cyanWall+    fg: '#00ffff'+objectives:+  - goal:+      - Place all fences+    condition: |+      as base {+        hasFence <- has "fence";+        pure $ not hasFence;+      }+solution: |+  def doN = \n. \f. if (n > 0) {f; doN (n - 1) f} {}; end;++  doN 4 (+    doN 6 (place "fence"; move);+    turn left;+  );++  doN 2 move;+  turn left;++  doN 2 (+    doN 2 move;+    place "fence";+  );+  turn right;+  move;+  turn right;+  move;+  place "fence";+  move;+  place "fence";+  move;+robots:+  - name: base+    dir: east+    display:+      attr: robot+    devices:+      - branch predictor+      - comparator+      - compass+      - dictionary+      - grabber+      - logger+      - treads+      - antenna+      - ADT calculator+    inventory:+      - [28, fence]+entities:+  - name: wall+    display:+      char: 'x'+      attr: purpleWall+    description:+      - A wall+    properties: [known, boundary]+  - name: fence+    display:+      char: 'F'+      attr: cyanWall+    description:+      - A fence+    properties: [known, boundary]+known: [boulder]+world:+  default: [blank]+  palette:+    'Ω': [grass, null, base]+    '.': [grass]+    '#': [grass, wall]+    '@': [grass, boulder]+  upperleft: [0, 0]+  map: |+    Ω.........+    ....#.....+    ..####..##+    ..#.##....+    ..#..#..#.+    ..####..#.+    ..........+    ...@@@....+    ...@.@....+    ...@@@....
data/scenarios/Testing/1295-density-command.yaml view
@@ -9,7 +9,7 @@       j <- robotnamed "judge";       as j {         c <- density ((0, 0), (3, 3));-        return $ c <= 13;+        pure $ c <= 13;       }; solution: |   def doN = \n. \f. if (n > 0) {f; doN (n - 1) f} {}; end;
data/scenarios/Testing/1320-world-DSL/constant.yaml view
@@ -5,7 +5,7 @@   single cell value. objectives:   - condition: |-      as base { n <- count "tree"; return (n >= 4) }+      as base { n <- count "tree"; pure (n >= 4) }     goal:       - Get 4 trees solution: |
data/scenarios/Testing/1320-world-DSL/erase.yaml view
@@ -4,7 +4,7 @@   Test that we can erase entities when overlaying objectives:   - condition: |-      as base { n <- count "tree"; return (n == 0) }+      as base { n <- count "tree"; pure (n == 0) }     goal:       - Get rid of your trees. solution: |
data/scenarios/Testing/1320-world-DSL/override.yaml view
@@ -4,7 +4,7 @@   Test that later entities override earlier ones when overlaying objectives:   - condition: |-      as base { n <- count "tree"; return (n == 1) }+      as base { n <- count "tree"; pure (n == 1) }     goal:       - Get a tree. solution: |
data/scenarios/Testing/1320-world-DSL/reflect.yaml view
@@ -8,7 +8,7 @@   - goal:       - Pick up four trees     condition: |-      as base {n <- count "tree"; return (n >= 4)}+      as base {n <- count "tree"; pure (n >= 4)} robots:   - name: base     loc: [0, 0]@@ -27,8 +27,8 @@   def x = \n. \c. if (n==0) {} {c; x (n-1) c} end   def ifC = \p. \t. \e. b <- p; if b t e end   def findTree = ifC (ishere "tree") {whereami} {move; findTree} end-  def ell = \d. turn right; x (2*d) move; grab; return () end-  def grabTrees = \loc. let x = fst loc in let y = snd loc in grab; ell y; ell x; ell y end+  def ell = \d. turn right; x (2*d) move; grab; pure () end+  def grabTrees = \loc. match loc \x. \y. grab; ell y; ell x; ell y end   n <- random 10;   x (n+1) move; turn right; move;   loc <- findTree;
data/scenarios/Testing/1322-wait-with-instant.yaml view
@@ -17,9 +17,11 @@       t <- robotnamed "tortoise";       tortoiseloc <- as t {whereami}; -      let xDiff = fst hareloc - fst tortoiseloc in+      match hareloc \harex. \_.+      match tortoiseloc \tortoisex. \_.+      let xDiff = harex - tortoisex in -      return $ fst hareloc == 0 && xDiff == 3;+      pure $ harex == 0 && xDiff == 3; solution: |   noop; robots:@@ -58,7 +60,6 @@   dsl: |     {blank}   upperleft: [-6, 2]-  offset: false   palette:     '.': [grass, erase]     'd': [dirt, erase]
data/scenarios/Testing/1341-command-count.yaml view
@@ -22,7 +22,7 @@     move;     grab;   } {-    return "";+    pure "";   }; robots:   - name: base
data/scenarios/Testing/1355-combustion.yaml view
@@ -21,6 +21,7 @@   ignite forward;   turn right;   move; move; move;+  ignite left;   turn right;   move;   ignite left;@@ -75,6 +76,18 @@       duration: [8, 8]       product: null     properties: [known, pickable, combustible]+  - name: slowfuse+    display:+      attr: silver+      char: '~'+    description:+      - Reliably combustible, but burns more slowly+    combustion:+      ignition: 20+      duration: [64, 64]+      delay: 63+      product: null+    properties: [known, pickable, combustible]   - name: dynamite     display:       attr: red@@ -103,6 +116,7 @@     'b': [grass, board]     'i': [grass, cotton]     'F': [grass, fuse]+    'f': [grass, slowfuse]     'd': [grass, dynamite, judge]     '.': [grass]   upperleft: [0, 0]@@ -123,11 +137,11 @@     ......iiiiiiii........F...F...F...F..     iiiiiiiiiiiiiii..Ω.FFFF...FFFFF...d..     ......iiiiiiii.......................-    iiiiiiiiiiiii.....qqqqqqqqqqqqqqqq...-    ......iiiiii......qqqqqqqqqqqqqqqq...-    iiiiiiiiiii.......qqqqqqqqqqqqqqqq...-    ..................qqqqqqqqqqqqqqqq...-    ..................qqqqqqqqqqqqqqqq...-    ..................qqqqqqqqqqqqqqqq...-    ..................qqqqqqqqqqqqqqqq...+    iiiiiiiiiiiii..f..qqqqqqqqqqqqqqqq...+    ......iiiiii...f..qqqqqqqqqqqqqqqq...+    iiiiiiiiiii....f..qqqqqqqqqqqqqqqq...+    ...............f..qqqqqqqqqqqqqqqq...+    ..ffff...ffff..f..qqqqqqqqqqqqqqqq...+    ..f..f...f..f..f..qqqqqqqqqqqqqqqq...+    ..f..fffff..ffff..qqqqqqqqqqqqqqqq...     ..................qqqqqqqqqqqqqqqq...
data/scenarios/Testing/1356-portals/_automatic-waypoint-patrol/program.sw view
@@ -1,12 +1,12 @@ def doN = \n. \f. if (n > 0) {f; doN (n - 1) f} {}; end; def abs = \n. if (n < 0) {-n} {n} end; -def mapTuple = \f. \t.-    (f $ fst t, f $ snd t)-    end;+def λmatch = \f. \p. match p f end -def sumTuples = \t1. \t2.-    (fst t1 + fst t2, snd t1 + snd t2);+def mapTuple = \f. λmatch \a. \b. (f a, f b) end;++def sumTuples = λmatch \t11. \t12. λmatch \t21. \t22.+    (t11 + t21, t12 + t22);     end;  def negateTuple = \t.@@ -15,12 +15,10 @@  def getRelativeLocation = \absCurrentLoc. \absDestLoc.     let negatedLoc = negateTuple absCurrentLoc in-    return $ sumTuples negatedLoc absDestLoc;+    pure $ sumTuples negatedLoc absDestLoc;     end; -def moveTuple = \tup.-    let x = fst tup in-    let y = snd tup in+def moveTuple = λmatch \x. \y.     turn $ if (x > 0) {east} {west};     doN (abs x) move;     turn $ if (y > 0) {north} {south};@@ -32,18 +30,21 @@     moveTuple relativeDestination;     end; -def visitNextWaypoint = \nextWpIdx.+def visitNextWaypoint : (rec l. Unit + (Int * Int) * l) -> (rec l. Unit + (Int * Int) * l) -> Cmd Unit = \originalList. \remainingList.     loc <- whereami;-    nextWaypointQuery <- waypoint "wp" nextWpIdx;-    goToLocation loc $ snd nextWaypointQuery; -    visitNextWaypoint $ nextWpIdx + 1;+    // Wrap around+    let myList = case remainingList (\_. originalList) (\_. remainingList) in++    case myList pure (λmatch \hd. \tl.+        goToLocation loc hd;+        visitNextWaypoint originalList tl;+    );     end;  def go =-    waypointQuery <- waypoint "wp" 0;-    teleport self $ snd waypointQuery;-    visitNextWaypoint 1;+    let wpList = waypoints "wp" in+    visitNextWaypoint wpList wpList;     end;  go;
data/scenarios/Testing/1356-portals/_portals-flip-and-rotate/solution.sw view
@@ -2,12 +2,12 @@  def abs = \n. if (n < 0) {-n} {n} end; -def mapTuple = \f. \t.-    (f $ fst t, f $ snd t)-    end;+def λmatch = \f. \p. match p f end -def sumTuples = \t1. \t2.-    (fst t1 + fst t2, snd t1 + snd t2);+def mapTuple = \f. λmatch \a. \b. (f a, f b) end;++def sumTuples = λmatch \t11. \t12. λmatch \t21. \t22.+    (t11 + t21, t12 + t22);     end;  def negateTuple = \t.@@ -16,12 +16,10 @@  def getRelativeLocation = \absCurrentLoc. \absDestLoc.     let negatedLoc = negateTuple absCurrentLoc in-    return $ sumTuples negatedLoc absDestLoc;+    pure $ sumTuples negatedLoc absDestLoc;     end; -def moveTuple = \tup.-    let x = fst tup in-    let y = snd tup in+def moveTuple = λmatch \x. \y.     turn $ if (x > 0) {east} {west};     doN (abs x) move;     turn $ if (y > 0) {north} {south};
data/scenarios/Testing/1356-portals/automatic-waypoint-patrol.yaml view
@@ -21,12 +21,7 @@   palette:     '.': [grass]     '*': [stone, flower]-    '┌': [stone, upper left corner]-    '┐': [stone, upper right corner]-    '└': [stone, lower left corner]-    '┘': [stone, lower right corner]-    '─': [stone, horizontal wall]-    '│': [stone, vertical wall]+    '+': [stone, wall]   structures:     - name: bigbox       structure:@@ -59,14 +54,14 @@       orient:         up: west   map: |-    ┌───────────┐-    │*..*..*..*.│-    │.*..*..*..*│-    │..*..*..*..│-    │*..*..*..*.│-    │.*..*..*..*│-    │..*..*..*..│-    │*..*..*..*.│-    │.*..*..*..*│-    │..*..*..*..│-    └───────────┘+    ++++++++++++++    +*..*..*..*.++    +.*..*..*..*++    +..*..*..*..++    +*..*..*..*.++    +.*..*..*..*++    +..*..*..*..++    +*..*..*..*.++    +.*..*..*..*++    +..*..*..*..++    +++++++++++++
data/scenarios/Testing/1356-portals/portals-and-waypoints.yaml view
@@ -37,12 +37,7 @@     '.': [grass]     '*': [stone, flower]     'p': [grass, telepad exit]-    '┌': [stone, upper left corner]-    '┐': [stone, upper right corner]-    '└': [stone, lower left corner]-    '┘': [stone, lower right corner]-    '─': [stone, horizontal wall]-    '│': [stone, vertical wall]+    '+': [stone, wall]   structures:     - name: bitpair       structure:@@ -102,13 +97,13 @@       exitInfo:         exit: meadow   map: |-    ┌────────────┐-    │*..*..*..*.p│-    │.*..*..*..*.│-    │..*..*..*..*│-    │*..*..*..*..│-    │.*..*..*..*.│-    │..*..*..*..*│-    │*..*..*..*..│-    │.*..*..*..*.│-    └────────────┘+    +++++++++++++++    +*..*..*..*.p++    +.*..*..*..*.++    +..*..*..*..*++    +*..*..*..*..++    +.*..*..*..*.++    +..*..*..*..*++    +*..*..*..*..++    +.*..*..*..*.++    ++++++++++++++
data/scenarios/Testing/1356-portals/portals-flip-and-rotate.yaml view
@@ -54,12 +54,7 @@     '.': [grass]     '*': [stone, flower]     'b': [stone, bitcoin]-    '┌': [stone, upper left corner]-    '┐': [stone, upper right corner]-    '└': [stone, lower left corner]-    '┘': [stone, lower right corner]-    '─': [stone, horizontal wall]-    '│': [stone, vertical wall]+    '+': [stone, wall]     'p':       cell: [dirt, telepad exit, base]       waypoint:@@ -123,20 +118,20 @@       exitInfo:         exit: portal_out   map: |-    ┌──────────────────────────────┐-    │p..*..*..*..*..*..*..*..*..*..│-    │.*..*..*..*..*..*..*..*..*..*.│-    │..*..*..*..*..*..*..*..*..*..*│-    │*..*..*..*..*..*..*..*..*..*..│-    │.*..*..*..*..*..*..*..*..*..*.│-    │..*..*..*..*..*..*..*..*..*..*│-    │*..*..*..*..*..*..*..*..*..*..│-    │.*..*..*..*..*..*..*..*..*..*.│-    │..*..*..*..*..*..*..*..*..*..*│-    │*..*..*..*..*..*..*..*..*..*..│-    │.*..*..*..*..*..*..*..*..*..*.│-    │..*..*..*..*..*..*..*..*..*..*│-    │*..*..*..*..*..*..*..*..*..*..│-    │.*..*..*..*..*..*..*..*..*..*.│-    │..*..*..*..*..*..*..*..*..*..b│-    └──────────────────────────────┘+    +++++++++++++++++++++++++++++++++    +p..*..*..*..*..*..*..*..*..*..++    +.*..*..*..*..*..*..*..*..*..*.++    +..*..*..*..*..*..*..*..*..*..*++    +*..*..*..*..*..*..*..*..*..*..++    +.*..*..*..*..*..*..*..*..*..*.++    +..*..*..*..*..*..*..*..*..*..*++    +*..*..*..*..*..*..*..*..*..*..++    +.*..*..*..*..*..*..*..*..*..*.++    +..*..*..*..*..*..*..*..*..*..*++    +*..*..*..*..*..*..*..*..*..*..++    +.*..*..*..*..*..*..*..*..*..*.++    +..*..*..*..*..*..*..*..*..*..*++    +*..*..*..*..*..*..*..*..*..*..++    +.*..*..*..*..*..*..*..*..*..*.++    +..*..*..*..*..*..*..*..*..*..b++    ++++++++++++++++++++++++++++++++
data/scenarios/Testing/1430-built-robot-ownership.yaml view
@@ -48,7 +48,7 @@     condition: |       r2 <- robotNumbered 2;       r3 <- robotNumbered 3;-      return true+      pure true known: [] world:   palette:
data/scenarios/Testing/144-subworlds/00-ORDER.txt view
@@ -3,3 +3,4 @@ subworld-mapped-robots.yaml subworld-located-robots.yaml spatial-consistency-enforcement.yaml+teleport-and-query.yaml
data/scenarios/Testing/144-subworlds/_subworld-located-robots/solution.sw view
@@ -6,5 +6,5 @@  doN 5 move; r <- meet;-case r return $ \j. give j f;+case r pure $ \j. give j f;
data/scenarios/Testing/144-subworlds/_subworld-mapped-robots/judges.sw view
@@ -2,7 +2,7 @@ def getRobotNumber = \n.     r <- robotnumbered n;     if (r == self) {-        return n;+        pure n;     } {getRobotNumber $ n + 1};     end; @@ -10,7 +10,7 @@     r <- robotnumbered idx;     thisName <- as r {whoami};     if (thisName == targetName) {-        return $ r == self;+        pure $ r == self;     } {amLowestRecursive targetName $ idx + 1};     end;
data/scenarios/Testing/144-subworlds/_subworld-mapped-robots/solution.sw view
@@ -4,5 +4,5 @@ doN 16 move;  r <- meet;-case r return $ \j. give j "bitcoin";+case r pure $ \j. give j "bitcoin";
+ data/scenarios/Testing/144-subworlds/teleport-and-query.yaml view
@@ -0,0 +1,67 @@+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;+        match myloc \w. \_.+        pure $ w == "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.....+    ..........
data/scenarios/Testing/1533-sow-command.yaml view
@@ -10,9 +10,6 @@   - name: clay     fg: "#444444"     bg: "#c2b280"-  - name: wheat-    fg: "#444444"-    bg: "#F5DEB3"   - name: barley     fg: "#444444"     bg: "#F6E9B1"@@ -34,7 +31,7 @@       r <- robotnamed "kudzubot";       as r {         kCount <- resonate "kudzu" ((0, 0), (10, 4));-        return $ kCount >= 45;+        pure $ kCount >= 45;       } solution: |   def doN = \n. \f. if (n > 0) {f; doN (n - 1) f} {}; end;@@ -80,19 +77,6 @@     dir: east     system: true entities:-  - name: wheat-    display:-      char: 'w'-      attr: wheat-    description:-      - Grain-    properties: [known, pickable, growable]-    growth:-      duration: [20, 30]-      spread:-        radius: 2-        density: 0.3-    biomes: [dirt, clay]   - name: barley     display:       char: 'b'
data/scenarios/Testing/1533-sow-seed-maturation.yaml view
@@ -22,7 +22,7 @@     condition: |       as base {         x <- has "acorn";-        return $ not x;+        pure $ not x;       }   - goal:       - |
data/scenarios/Testing/1535-ping/1535-out-of-range.yaml view
@@ -11,7 +11,7 @@       r <- robotnamed "buddy";       as r {         response <- ping base;-        return $ case response (\_. true) (\_. false);+        pure $ case response (\_. true) (\_. false);       } solution: |   run "scenarios/Testing/1535-ping/_1535-out-of-range/solution.sw"
data/scenarios/Testing/1535-ping/_1535-in-range/solution.sw view
@@ -3,26 +3,24 @@ def goToBuddy = \loc.      // log $ format loc;-    -    let longitudinalDist = snd loc in+    match loc \lateralDist. \longitudinalDist.     absFwd <- if (longitudinalDist < 0) {         turn back;-        return $ -longitudinalDist;+        pure $ -longitudinalDist;     } {-        return longitudinalDist;+        pure longitudinalDist;     };     doN absFwd move;     if (longitudinalDist < 0) {         turn back;     } {}; -    let lateralDist = fst loc in     absSide <- if (lateralDist < 0) {         turn left;-        return $ -lateralDist;+        pure $ -lateralDist;     } {         turn right;-        return lateralDist;+        pure lateralDist;     };     doN absSide move;     end;@@ -30,7 +28,7 @@ def checkNeedToMove = \f. \loc.     wait 3;     if (loc == (0, 0)) {-        return ()+        pure ()     } {         goToBuddy loc;         f;@@ -39,7 +37,7 @@  def pingLoop = \buddy.     maybeLoc <- ping buddy;-    case maybeLoc return $ checkNeedToMove $ pingLoop buddy;+    case maybeLoc pure $ checkNeedToMove $ pingLoop buddy;     end;  def giveToBuddy = \buddy.@@ -50,7 +48,7 @@ def go =     move;     maybeBuddy <- meet;-    case maybeBuddy return giveToBuddy;+    case maybeBuddy pure giveToBuddy;     grab;     end;
data/scenarios/Testing/1569-pathfinding-cache/1569-cache-invalidation-modes.yaml view
@@ -32,7 +32,7 @@    def forceBlockageInvalidation =     build {-      require 1 "monolith";+      stock 1 "monolith";       move;       place "monolith";       turn back;@@ -55,7 +55,7 @@    def forceCompetingTargetInvalidation =     build {-      require 1 "flower";+      stock 1 "flower";       turn right;       move;       place "flower";@@ -106,28 +106,28 @@ entities:   - name: wayfinder     display:-      char: 'w'+      char: "w"     description:       - Enables `path` command     properties: [known, pickable]     capabilities: [path]   - name: monolith     display:-      char: '@'+      char: "@"       attr: rock     description:       - Pushable rock     properties: [known, unwalkable, pickable]   - name: lemon     display:-      char: 'o'+      char: "o"       attr: gold     description:       - Sour fruit     properties: [known, pickable]   - name: lemonade     display:-      char: 'c'+      char: "c"       attr: gold     description:       - Sweet drink@@ -166,9 +166,9 @@ known: [flower] world:   palette:-    'B': [grass, erase, base]-    '.': [grass]-    'f': [grass, flower]+    "B": [grass, erase, base]+    ".": [grass]+    "f": [grass, flower]   upperleft: [0, 0]   map: |     .....
data/scenarios/Testing/1569-pathfinding-cache/1569-harvest-batch.yaml view
@@ -12,17 +12,17 @@     condition: |       as base {         fCount <- count "flower";-        return $ fCount >= 4;+        pure $ fCount >= 4;       }; solution: |   def goDir = \f. \result.-    let d = fst result in+    match result \d. \_.     if (d == down) {grab; f;} {turn d; move; f;}     end;    def followRoute =       nextDir <- path (inL ()) (inR "flower");-      case nextDir return $ goDir followRoute;+      case nextDir pure $ goDir followRoute;       end;    followRoute;
data/scenarios/Testing/1575-structure-recognizer/00-ORDER.txt view
@@ -14,3 +14,9 @@ 1575-bounding-box-overlap.yaml 1644-rotated-recognition.yaml 1644-rotated-preplacement-recognition.yaml+2115-encroaching-upon-exterior-transparent-cells.yaml+2115-encroaching-upon-interior-transparent-cells.yaml+2201-piecewise-lines.yaml+2201-preclude-overlapping-recognition.yaml+2201-initial-recognition-overlap.yaml+2229-position-uniqueness-multiple-orientations.yaml
data/scenarios/Testing/1575-structure-recognizer/1575-bounding-box-overlap.yaml view
@@ -14,8 +14,16 @@       - |         Build 3 `chevron`{=structure} structures     condition: |-      foundStructure <- structure "chevron" 0;-      return $ case foundStructure (\_. false) (\x. fst x >= 3);+      def λmatch = \f. \p. match p f end+      def λcase = \f. \g. \s. case s f g end++      def length : (rec l. Unit + a * l) -> Int = λcase+        (\_. 0)+        (λmatch \_. \rest. 1 + length rest)+      end++      foundStructures <- structures "chevron";+      pure $ length foundStructures >= 3 robots:   - name: base     dir: east
data/scenarios/Testing/1575-structure-recognizer/1575-browse-structures.yaml view
@@ -14,8 +14,8 @@       - |         Build a `precious`{=structure} structure     condition: |-      foundStructure <- structure "precious" 0;-      return $ case foundStructure (\_. false) (\_. true);+      foundStructure <- structures "precious";+      pure $ case foundStructure (\_. false) (\_. true); robots:   - name: base     dir: east
data/scenarios/Testing/1575-structure-recognizer/1575-construction-count.yaml view
@@ -9,8 +9,11 @@       - |         Build 12 copies of the `green_jewel`{=structure} structure     condition: |-      foundGreen <- structure "green_jewel" 0;-      return $ case foundGreen (\_. false) (\x. fst x >= 12);+      def length : (rec l. Unit + a * l) -> Int = \l.+        case l (\_. 0) (\cons. match cons \_. \rest. 1 + length rest)+      end;+      foundGreen <- structures "green_jewel";+      pure $ length foundGreen >= 12; robots:   - name: base     dir: east
data/scenarios/Testing/1575-structure-recognizer/1575-ensure-disjoint.yaml view
@@ -16,11 +16,11 @@       - |         Build 2 of the same structure     condition: |-      foundStructure <- structure "chessboard" 0;-      return $ case foundStructure (\_. false) (\fs.-        let boardCount = fst fs in-        boardCount >= 2;-      );+      def length : (rec l. Unit + a * l) -> Int = \l.+        case l (\_. 0) (\cons. match cons \_. \rest. 1 + length rest)+      end;+      foundStructures <- structures "chessboard";+      pure $ length foundStructures >= 2   - id: premature_win     teaser: Don't count win early     optional: true@@ -29,13 +29,13 @@         Two structures shouldn't be recognized         while the bases still possesses `silver`{=entity}     condition: |+      def length : (rec l. Unit + a * l) -> Int = \l.+        case l (\_. 0) (\cons. match cons \_. \rest. 1 + length rest)+      end;       robotHasSilver <- as base {has "silver"}; -      foundStructure <- structure "chessboard" 0;-      return $ case foundStructure (\_. false) (\fs.-        let boardCount = fst fs in-        boardCount >= 2 && robotHasSilver;-      );+      foundStructures <- structures "chessboard";+      pure $ length foundStructures >= 2 && robotHasSilver; robots:   - name: base     dir: south
data/scenarios/Testing/1575-structure-recognizer/1575-ensure-single-recognition.yaml view
@@ -13,11 +13,11 @@       - |         Build 2 of the same structure     condition: |-      foundStructure <- structure "chessboard" 0;-      return $ case foundStructure (\_. false) (\fs.-        let boardCount = fst fs in-        boardCount >= 2;-      );+      def length : (rec l. Unit + a * l) -> Int = \l.+        case l (\_. 0) (\cons. match cons \_. \rest. 1 + length rest)+      end;+      foundStructures <- structures "chessboard";+      pure $ length foundStructures >= 2;   - id: premature_win     teaser: Don't count win early     optional: true@@ -26,13 +26,13 @@         Two structures shouldn't be recognized         while the bases still possesses `gold`{=entity}     condition: |+      def length : (rec l. Unit + a * l) -> Int = \l.+        case l (\_. 0) (\cons. match cons \_. \rest. 1 + length rest)+      end;       robotHasGold <- as base {has "gold"}; -      foundStructure <- structure "chessboard" 0;-      return $ case foundStructure (\_. false) (\fs.-        let boardCount = fst fs in-        boardCount >= 2 && robotHasGold;-      );+      foundStructures <- structures "chessboard";+      pure $ length foundStructures >= 2 && robotHasGold; robots:   - name: base     dir: south
data/scenarios/Testing/1575-structure-recognizer/1575-floorplan-command.yaml view
@@ -11,8 +11,8 @@         Build a `wooden box`{=structure} structure.     condition: |       def isRight = \x. case x (\_. false) (\_. true); end;-      foundBox <- structure "wooden box" 0;-      return $ isRight foundBox;+      foundBox <- structures "wooden box";+      pure $ isRight foundBox; robots:   - name: base     dir: east@@ -41,9 +41,7 @@     end;    dims <- floorplan "wooden box";-  let width = fst dims in-  let height = snd dims in-+  match dims \width. \height.   mkRows height width; structures:   - name: wooden box
data/scenarios/Testing/1575-structure-recognizer/1575-handle-overlapping.yaml view
@@ -10,8 +10,8 @@       - |         Build a `precious`{=structure} structure     condition: |-      foundStructure <- structure "precious" 0;-      return $ case foundStructure (\_. false) (\_. true);+      foundStructure <- structures "precious";+      pure $ case foundStructure (\_. false) (\_. true); robots:   - name: base     dir: east
data/scenarios/Testing/1575-structure-recognizer/1575-interior-entity-placement.yaml view
@@ -9,10 +9,6 @@   Additionally, recognition of statically-placed   structures at scenario initialization is also   unaffected by interior entities.--  However, any such "contaminating" entities-  will prevent the recognition of a structure-  when constructed by a robot. creative: false objectives:   - teaser: Replace rock@@ -21,9 +17,9 @@       - |         Place the `rock`{=entity} entity back inside the `pigpen`{=structure}.     condition: |-      foundBox <- structure "pigpen" 0;-      case foundBox (\_. return false) (\struc.-        let structPos = snd struc in+      foundBoxes <- structures "pigpen";+      case foundBoxes (\_. pure false) (\cons.+        match cons \structPos. \_.         j <- robotnamed "judge";         as j {           structBounds <- floorplan "pigpen";@@ -32,7 +28,7 @@           teleport self structPos;            rockCount <- resonate "rock" ((0, 0), structBounds);-          return $ rockCount > 0;+          pure $ rockCount > 0;         }       );   - teaser: Grab rock@@ -53,8 +49,8 @@         even with an extraneous entity within its bounds.     condition: |       def isRight = \x. case x (\_. false) (\_. true); end;-      foundBox <- structure "pigpen" 0;-      return $ isRight foundBox;+      foundBoxes <- structures "pigpen";+      pure $ isRight foundBoxes; robots:   - name: base     dir: east
data/scenarios/Testing/1575-structure-recognizer/1575-nested-structure-definition.yaml view
@@ -13,8 +13,8 @@         Replace `tree`{=entity} after grabbing.         The `double ring`{=structure} structure should be recognized again.     condition: |-      foundStructure <- structure "double ring" 0;-      return $ case foundStructure (\_. false) (\_. true);+      foundStructure <- structures "double ring";+      pure $ case foundStructure (\_. false) (\_. true);   - teaser: Pre-recognized     id: pre_recognized     prerequisite:@@ -23,8 +23,8 @@       - |         Pre-placed structure must be recognized     condition: |-      foundStructure <- structure "double ring" 0;-      return $ case foundStructure (\_. false) (\_. true);+      foundStructure <- structures "double ring";+      pure $ case foundStructure (\_. false) (\_. true);   - teaser: Grab tree     id: grab_tree     goal:
data/scenarios/Testing/1575-structure-recognizer/1575-overlapping-tiebreaker-by-largest.yaml view
@@ -11,8 +11,8 @@       - |         Build a 3x3 structure     condition: |-      foundStructure <- structure "large" 0;-      return $ case foundStructure (\_. false) (\_. true);+      foundStructure <- structures "large";+      pure $ case foundStructure (\_. false) (\_. true);   - id: wrong_structure     teaser: Don't recognize small structure     optional: true@@ -20,8 +20,8 @@       - |         The small structure shouldn't be recognized.     condition: |-      foundStructure <- structure "small" 0;-      return $ case foundStructure (\_. false) (\_. true);+      foundStructure <- structures "small";+      pure $ case foundStructure (\_. false) (\_. true); robots:   - name: base     dir: east
data/scenarios/Testing/1575-structure-recognizer/1575-overlapping-tiebreaker-by-location.yaml view
@@ -12,8 +12,8 @@       - |         Build a `topleft`{=structure} structure     condition: |-      foundStructure <- structure "topleft" 0;-      return $ case foundStructure (\_. false) (\_. true);+      foundStructure <- structures "topleft";+      pure $ case foundStructure (\_. false) (\_. true);   - id: wrong_structure     teaser: Don't recognize small structure     optional: true@@ -21,8 +21,8 @@       - |         The `bottomright`{=structure} structure shouldn't be recognized.     condition: |-      foundStructure <- structure "bottomright" 0;-      return $ case foundStructure (\_. false) (\_. true);+      foundStructure <- structures "bottomright";+      pure $ case foundStructure (\_. false) (\_. true); robots:   - name: base     dir: east
data/scenarios/Testing/1575-structure-recognizer/1575-placement-occlusion.yaml view
@@ -15,8 +15,8 @@     condition: |       def isRight = \x. case x (\_. false) (\_. true); end; -      foundGreen <- structure "green_jewel" 0;-      return $ isRight foundGreen;+      foundGreen <- structures "green_jewel";+      pure $ isRight foundGreen;   - id: complete_red_structure     optional: true     teaser: Complete red structure@@ -26,8 +26,8 @@     condition: |       def isRight = \x. case x (\_. false) (\_. true); end; -      foundRed <- structure "red_jewel" 0;-      return $ isRight foundRed;+      foundRed <- structures "red_jewel";+      pure $ isRight foundRed; robots:   - name: base     dir: east
data/scenarios/Testing/1575-structure-recognizer/1575-remove-structure.yaml view
@@ -11,16 +11,16 @@       - |         Remove a piece of the structure to destroy it     condition: |-      foundStructure <- structure "chessboard" 0;-      return $ case foundStructure (\_. true) (\_. false);+      foundStructures <- structures "chessboard";+      pure $ case foundStructures (\_. true) (\_. false);   - id: complete_structure     teaser: Complete structure     goal:       - |         Build a `chessboard`{=structure} structure     condition: |-      foundStructure <- structure "chessboard" 0;-      return $ case foundStructure (\_. false) (\_. true);+      foundStructures <- structures "chessboard";+      pure $ case foundStructures (\_. false) (\_. true); robots:   - name: base     dir: south
data/scenarios/Testing/1575-structure-recognizer/1575-swap-structure.yaml view
@@ -13,10 +13,10 @@     condition: |       def isRight = \x. case x (\_. false) (\_. true); end; -      foundBlue <- structure "blue_jewel" 0;-      foundGreen <- structure "green_jewel" 0;-      foundRed <- structure "red_jewel" 0;-      return $ isRight foundBlue && not (isRight foundRed) && not (isRight foundRed);+      foundBlue <- structures "blue_jewel";+      foundGreen <- structures "green_jewel";+      foundRed <- structures "red_jewel";+      pure $ isRight foundBlue && not (isRight foundRed) && not (isRight foundRed);   - id: complete_green_structure     teaser: Complete green structure     prerequisite: complete_red_structure@@ -26,9 +26,9 @@     condition: |       def isRight = \x. case x (\_. false) (\_. true); end; -      foundGreen <- structure "green_jewel" 0;-      foundRed <- structure "red_jewel" 0;-      return $ isRight foundGreen && not (isRight foundRed);+      foundGreen <- structures "green_jewel";+      foundRed <- structures "red_jewel";+      pure $ isRight foundGreen && not (isRight foundRed);   - id: complete_red_structure     teaser: Complete red structure     goal:@@ -37,8 +37,8 @@     condition: |       def isRight = \x. case x (\_. false) (\_. true); end; -      foundRed <- structure "red_jewel" 0;-      return $ isRight foundRed;+      foundRed <- structures "red_jewel";+      pure $ isRight foundRed; robots:   - name: base     dir: east
data/scenarios/Testing/1575-structure-recognizer/1644-rotated-preplacement-recognition.yaml view
@@ -9,8 +9,8 @@       - |         Have a `tee`{=structure} structure     condition: |-      foundStructure <- structure "tee" 0;-      return $ case foundStructure (\_. false) (\_. true);+      foundStructure <- structures "tee";+      pure $ case foundStructure (\_. false) (\_. true); robots:   - name: base     dir: east
data/scenarios/Testing/1575-structure-recognizer/1644-rotated-recognition.yaml view
@@ -9,8 +9,8 @@       - |         Build a `tee`{=structure} structure     condition: |-      foundStructure <- structure "tee" 0;-      return $ case foundStructure (\_. false) (\_. true);+      foundStructure <- structures "tee";+      pure $ case foundStructure (\_. false) (\_. true); robots:   - name: base     dir: east
+ data/scenarios/Testing/1575-structure-recognizer/2115-encroaching-upon-exterior-transparent-cells.yaml view
@@ -0,0 +1,77 @@+version: 1+name: Structure recognition - exterior transparency+description: |+  Incursion of an entity of a foreign type+  upon a "transparent" cell within the bounding box+  of a recognizable structure shall not prevent+  the structure from being recognized.++  If the incurring entity is the *same* type as+  a participating entity in that structure, however,+  it will prevent recognition.+creative: false+objectives:+  - teaser: Recognize structure+    goal:+      - |+        `chevron`{=structure} structure should be recognized upon completion,+        even with an extraneous entity within its bounds.+    condition: |+      def isRight = \x. case x (\_. false) (\_. true); end;++      foundBoxes <- structures "chevron";+      pure $ isRight foundBoxes;+robots:+  - name: base+    dir: east+    devices:+      - ADT calculator+      - blueprint+      - fast grabber+      - logger+      - treads+    inventory:+      - [1, board]+  - name: judge+    dir: east+    system: true+    display:+      invisible: true+solution: |+  move; move; move;+  swap "board";+structures:+  - name: chevron+    recognize: [north]+    structure:+      palette:+        'b': [stone, board]+      mask: '.'+      map: |+        .b+        bb+  - name: stripe+    recognize: [north]+    structure:+      palette:+        't': [grass, tree]+        'b': [grass, board]+      map: |+        btb+known: [board, mountain, tree]+world:+  dsl: |+    {blank}+  palette:+    '.': [grass, erase]+    'B': [grass, erase, base]+    'j': [grass, erase, judge]+    't': [grass, tree]+    'b': [grass, board]+  upperleft: [-7, 3]+  map: |+    j.....+    ......+    .B.ttt+    ...bb.+    ......
+ data/scenarios/Testing/1575-structure-recognizer/2115-encroaching-upon-interior-transparent-cells.yaml view
@@ -0,0 +1,85 @@+version: 1+name: Structure recognition - interior transparency+description: |+  Incursion of an entity of a foreign type+  upon a "transparent" cell within the bounding box+  of a recognizable structure shall not prevent+  the structure from being recognized.++  If the incurring entity is the *same* type as+  a participating entity in that structure, however,+  it will prevent recognition.+creative: false+objectives:+  - teaser: Recognize structure+    goal:+      - |+        `pigpen`{=structure} structure should be recognized upon completion,+        even with an extraneous entity within its bounds.+    condition: |+      def isRight = \x. case x (\_. false) (\_. true); end;+      foundBoxes <- structures "pigpen";+      pure $ isRight foundBoxes;+robots:+  - name: base+    dir: east+    devices:+      - ADT calculator+      - blueprint+      - fast grabber+      - logger+      - treads+    inventory:+      - [1, board]+  - name: judge+    dir: east+    system: true+    display:+      invisible: true+solution: |+  move; move; move; move;+  swap "board";+structures:+  - name: pigpen+    recognize: [north]+    structure:+      palette:+        'b': [stone, board]+      mask: '.'+      map: |+        bbbb+        b..b+        b..b+        bbbb+  - name: obstruction+    recognize: [north]+    structure:+      palette:+        't': [grass, tree]+        'b': [grass, board]+      map: |+        tttb+known: [board, mountain, tree]+world:+  dsl: |+    {blank}+  palette:+    '.': [grass, erase]+    'B': [grass, erase, base]+    'r': [grass, mountain]+    'j': [grass, erase, judge]+    'p':+      structure:+        name: pigpen+      cell: [grass]+    'b':+      structure:+        name: obstruction+      cell: [grass]+  upperleft: [-7, 3]+  map: |+    j.....+    .p....+    ...r..+    B..b..+    ......
+ data/scenarios/Testing/1575-structure-recognizer/2201-initial-recognition-overlap.yaml view
@@ -0,0 +1,62 @@+version: 1+name: Structure recognition - precluding initial overlaps+description: |+  A cell may be a member of at most one structure.++  Since recognition of pre-placed structures bypasses+  the regular "search" process, we need to ensure that+  overlaps are properly excluded by this alternate mechanism.+  In this scenario, only the upper-left structure should be recognized,+  based on the precedence criteria (structure size, then grid location)+creative: false+objectives:+  - teaser: Recognize exactly one structure+    goal:+      - |+        `square`{=structure} structure should be recognized upon scenario start.+      - |+        Although two of these structures were initially placed, only+        the upper-left one should be recognized.+    condition: |+      def length : (rec l. Unit + a * l) -> Int = \l.+        case l (\_. 0) (\c. match c \_. \tl. 1 + length tl)+      end;+      foundStructures <- structures "square";+      pure $ length foundStructures == 1;+robots:+  - name: base+    dir: north+    devices:+      - ADT calculator+      - blueprint+      - fast grabber+      - logger+      - treads+solution: |+  noop;+structures:+  - name: square+    recognize: [north]+    structure:+      palette:+        'x': [stone, rock]+      mask: '.'+      map: |+        xx+        xx+known: [rock]+world:+  dsl: |+    {blank}+  palette:+    '.': [grass, erase]+    'B': [grass, erase, base]+    's':+      structure:+        name: square+      cell: [grass]+  upperleft: [0, 0]+  map: |+    ...s...+    ....s..+    .B.....
+ data/scenarios/Testing/1575-structure-recognizer/2201-piecewise-lines.yaml view
@@ -0,0 +1,93 @@+version: 1+name: Structure recognition - piecewise row recognition+description: |+  Demonstrate general solution for transparency.++  In this scenario, a structure called `spaceship`{=structure} is occluded+  by a single cell overlay shape called `damage`{=structure}.++  The base swaps the "damage" entity with the correct part.+creative: false+objectives:+  - teaser: Recognize structure+    goal:+      - |+        `spaceship`{=structure} structure should be recognized upon completion.+    condition: |+      def isRight = \x. case x (\_. false) (\_. true); end;+      foundStructures <- structures "spaceship";+      pure $ isRight foundStructures;+robots:+  - name: base+    dir: east+    devices:+      - ADT calculator+      - blueprint+      - fast grabber+      - logger+      - treads+    inventory:+      - [1, rock]+solution: |+  move; move; move; move; move; move; move;+  swap "rock";+structures:+  - name: fragment+    recognize: [north]+    structure:+      palette:+        'z': [stone, pixel (R)]+        'w': [stone, pixel (B)]+        'x': [stone, rock]+        'y': [stone, mountain]+      mask: '.'+      map: |+        zw.xy+  - name: spaceship+    recognize: [north]+    structure:+      palette:+        'p': [stone, board]+        'x': [stone, rock]+        'y': [stone, mountain]+        'z': [stone, pixel (R)]+        'w': [stone, pixel (B)]+        'q': [stone, pixel (G)]+      mask: '.'+      map: |+        q....xy.zw.xy+        qq....ppp....+        q....xy.xy.qq+  - name: damage+    description: A single-cell overwrite of the spaceship+    structure:+      palette:+        't': [stone, tree]+      map: |+        t+  - name: modified ship+    description: A spaceship with a single cell replaced by a `tree`{=entity}+    structure:+      placements:+        - src: spaceship+        - src: damage+          offset: [5, 0]+      map: ""+known: [board, mountain, rock, tree, pixel (R), pixel (B)]+world:+  dsl: |+    {blank}+  palette:+    '.': [grass, erase]+    'B': [grass, erase, base]+    'p':+      structure:+        name: modified ship+      cell: [grass]+  upperleft: [100, -100]+  map: |+    ..........+    B.p.......+    ..........+    ..........+    ..........
+ data/scenarios/Testing/1575-structure-recognizer/2201-preclude-overlapping-recognition.yaml view
@@ -0,0 +1,94 @@+version: 1+name: Structure recognition - precluding overlaps+description: |+  A cell may be a member of at most one structure.+creative: false+objectives:+  - teaser: Recognize one structure+    goal:+      - |+        `line`{=structure} structure should be recognized upon completion.+    condition: |+      def isRight = \x. case x (\_. false) (\_. true); end;+      foundStructures <- structures "line";+      pure $ isRight foundStructures;+  - teaser: Recognize second structure+    id: found_elbow+    optional: true+    goal:+      - |+        `elbow`{=structure} structure should be recognized upon completion.+    condition: |+      def isRight = \x. case x (\_. false) (\_. true); end;+      foundStructures <- structures "elbow";+      pure $ isRight foundStructures;+  - teaser: Grab tree+    prerequisite:+      not: found_elbow+    goal:+      - |+        `grab` the `tree`{=entity} to indicate we are done with the test.+    condition: |+      as base {has "tree"};+robots:+  - name: base+    dir: north+    devices:+      - ADT calculator+      - blueprint+      - fast grabber+      - logger+      - treads+    inventory:+      - [5, rock]+solution: |+  place "rock"; move;+  place "rock"; move;+  place "rock";+  turn right;+  move;+  turn right;++  // Try to complete a second structure+  place "rock"; move;+  place "rock";++  // Grab the tree to indicate completion+  turn left;+  move;+  move;+  move;+  grab;+structures:+  - name: elbow+    recognize: [north]+    structure:+      palette:+        'x': [stone, rock]+      mask: '.'+      map: |+        xx+        .x+  - name: line+    recognize: [north]+    structure:+      palette:+        'x': [stone, rock]+      mask: '.'+      map: |+        x+        x+        x+known: [rock]+world:+  dsl: |+    {blank}+  palette:+    '.': [grass, erase]+    'T': [grass, tree]+    'B': [grass, erase, base]+  upperleft: [0, 0]+  map: |+    .......+    .....T.+    .B.....
+ data/scenarios/Testing/1575-structure-recognizer/2229-position-uniqueness-multiple-orientations.yaml view
@@ -0,0 +1,61 @@+version: 1+name: Structure recognition - rotated structures at same position+description: |+  A map keyed by (position, structure name) would not be sufficient to+  account for multiple orientations of the same structure, sharing the+  same top-left corner position.++  This is why the found structure registry must include orientation+  in its key.+creative: false+objectives:+  - teaser: Recognize both structures+    goal:+      - |+        Two `thingy`{=structure} structures should be recognized immediately.+        Without distinguishing them by orientation in the registry, only+        one would be recognized.+    condition: |+      def length : (rec l. Unit + a * l) -> Int = \l.+        case l (\_. 0) (\c. match c \_. \tl. 1 + length tl)+      end;+      foundStructures <- structures "thingy";+      pure $ length foundStructures == 2;+robots:+  - name: base+    dir: north+    devices:+      - logger+solution: |+  noop;+structures:+  - name: thingy+    recognize: [north, east]+    structure:+      palette:+        'x': [stone, rock]+        'y': [dirt]+      mask: '.'+      map: |+        y.y+        yxx+known: [rock]+world:+  dsl: |+    {blank}+  placements:+    - src: thingy+    - src: thingy+      offset: [0, 0]+      orient:+        up: east+  palette:+    '.': [grass, erase]+    'B': [grass, erase, base]+  upperleft: [-3, 3]+  map: |+    .........B.+    ...........+    ...........+    ...........+    ...........
+ data/scenarios/Testing/1592-shared-template-robot-say-logs.yaml view
@@ -0,0 +1,62 @@+version: 1+name: Logs from same-template robots+creative: false+description: |+  Logs from different robots generated from the same template.++  The objective checks that base hears one message each tick,+  afterwards the integration test checks that all messages+  are present in the base log.+objectives:+  - goal:+      - Please `grab` the `token`{=entity} if you hear what you expected.+    condition: |+      as base { has "token" }+solution: |+  s <- listen;+  if (s == "Hello from (2, -2)!") {+    s <- listen;+    if (s == "Hello from (3, -2)!") {+      s <- listen;+      if (s == "Hello from (4, -2)!") {+        grab; say "OK!"+      } {say $ "3: Not what I expected: " ++ s}+    } {say $ "2: Not what I expected: " ++ s}+  } {say $ "1: Not what I expected: " ++ s}+robots:+  - name: base+    devices:+      - logger+      - hearing aid+      - comparator+      - branch predictor+      - string+      - grabber+  - name: saybot+    system: true+    display:+      invisible: false+      attr: blue+    program: |+      loc <- whereami;+      match loc \x. \_.+      wait x;+      say ("Hello from " ++ format loc ++ "!");+entities:+  - name: token+    display:+      char: 'W'+    properties:+      - known+      - pickable+    description:+      - Signals a success.+world:+  palette:+    '.': [grass]+    'B': [grass, token, base]+    's': [grass, null, saybot]+  map: |+    B...s+    ...ss+    ..sss
data/scenarios/Testing/1598-detect-entity-change.yaml view
@@ -100,7 +100,6 @@   dsl: |     {blank}   upperleft: [-1, -1]-  offset: false   palette:     '.': [grass, erase]     'B': [grass, erase, base]
data/scenarios/Testing/1631-tags.yaml view
@@ -14,41 +14,29 @@     id: got_fruit     optional: true     condition: |-      // Returns true if prohibited item is in inventory.-      def checkFruit = \idx.-        result <- tagmembers "fruit" idx;-        let totalCount = fst result in-        let member = snd result in-        let nextIdx = idx + 1 in--        hasProhibited <- as base {has member};-        if hasProhibited {-          return true;-        } {-          if (nextIdx < totalCount) {-            checkFruit nextIdx;-          } {-            return false;-          }-        }-        end;+      def hasAny : (rec l. Unit + Text * l) -> Cmd Bool = \items.+        case items+          (\_. pure false)+          (\c. match c \hd. \tl. b <- has hd; if b {pure true} {hasAny tl})+      end; -      checkFruit 0;+      let prohibited = tagmembers "fruit" in+      hasAny prohibited     goal:       - |         Do not pick up any fruit. solution: |   def findTarget =     result <- scan down;-    isTarget <- case result (\_. return false) (\item.-      isEdible <- hastag item "edible";-      isFruit <- hastag item "fruit";-      return $ isEdible && not isFruit;+    isTarget <- case result (\_. pure false) (\item.+      let isEdible = hastag item "edible" in+      let isFruit = hastag item "fruit" in+      pure $ isEdible && not isFruit;     );      if isTarget {       grab;-      return ();+      pure ();     } {       move;       findTarget;
data/scenarios/Testing/1634-message-colors.yaml view
@@ -14,7 +14,8 @@       attr: blue     program: |       loc <- whereami;-      let idx = -(snd loc) in+      match loc \_. \y.+      let idx = -y in       wait $ idx + 1;       say $ "Hello saybot" ++ format idx; world:
data/scenarios/Testing/1642-biomes.yaml view
@@ -15,7 +15,7 @@     condition: |       as base {         c <- count "wheat";-        return $ c == 2;+        pure $ c == 2;       }   - id: western_wheat_regrew     optional: true@@ -40,7 +40,7 @@       baseLoc <- as base {whereami};       as goalbot {         goalLoc <- whereami;-        return $ baseLoc == goalLoc;+        pure $ baseLoc == goalLoc;       }     prerequisite:       logic:@@ -67,15 +67,6 @@     dir: east     system: true entities:-  - name: wheat-    display:-      char: 'w'-      attr: gold-    description:-      - Grain-    properties: [known, pickable, growable]-    growth: [2, 4]-    biomes: [dirt]   - name: scythe     display:       char: 'y'
data/scenarios/Testing/1721-custom-walkable-entities.yaml view
@@ -16,7 +16,7 @@       m <- robotnamed "monkey";       as m {         p <- path (inR 10) (inR "banana");-        return $ case p (\_. false) (\_. true);+        pure $ case p (\_. false) (\_. true);       };   - id: placed_tree     teaser: Tree placed@@ -26,7 +26,7 @@       - Tree must be placed     condition: |       x <- as base {has "tree"};-      return $ not x;+      pure $ not x; solution: |   move;   move;
data/scenarios/Testing/1721-walkability-whitelist-path-cache.yaml view
@@ -9,13 +9,13 @@       as base {ishere "platform"} solution: |   def goDir = \f. \result.-    let d = fst result in-    if (d == down) {return ()} {turn d; move; f;}+    match result \d. \_.+    if (d == down) {pure ()} {turn d; move; f;}     end;    def followRoute =       nextDir <- path (inL ()) (inR "platform");-      case nextDir return $ goDir followRoute;+      case nextDir pure $ goDir followRoute;       end;    followRoute;
data/scenarios/Testing/1747-volume-command.yaml view
@@ -11,7 +11,7 @@       as base {         let targetVolume = 14 in         vol <- volume targetVolume;-        return $case vol (\_. false) (\x. x == targetVolume);+        pure $case vol (\_. false) (\x. x == targetVolume);       } solution: |   move;
data/scenarios/Testing/1777-capability-cost.yaml view
@@ -17,10 +17,10 @@         judge <- robotnamed "judge";         as judge {           maybePath <- path (inL ()) (inR "packing peanut");-          return $ case maybePath (\_. true) (\d. false);+          pure $ case maybePath (\_. true) (\d. false);         }       } {-        return false;+        pure false;       }; solution: |   move;
data/scenarios/Testing/1780-structure-merge-expansion/00-ORDER.txt view
@@ -1,3 +1,6 @@ nonoverlapping-structure-merge.yaml root-map-expansion.yaml structure-composition.yaml+sequential-placement.yaml+coordinate-offset-propagation.yaml+simultaneous-north-and-west-offset.yaml
+ data/scenarios/Testing/1780-structure-merge-expansion/coordinate-offset-propagation.yaml view
@@ -0,0 +1,77 @@+version: 1+name: Structure coordinate offset propagation+author: Karl Ostmo+description: |+  If a structure incorporates subplacements+  entailing negative offsets, its coordinate origin must be shifted.++  The updated coordinate origin should be propagated to parent structures+  and utilized to offset placement.+robots:+  - name: base+    dir: north+    loc: [0, 3]+objectives:+  - goal:+      - Enjoy the view.+    condition: |+      pure true+solution: |+  noop+known: [boulder, log, pixel (R), pixel (G), pixel (B), gold]+world:+  structures:+    - name: micro+      structure:+        mask: '.'+        palette:+          'x': [stone, gold]+        map: |+          xx+    - name: block+      structure:+        mask: '.'+        palette:+          'x': [stone, pixel (R)]+        map: |+          xx+          xx+    - name: master+      structure:+        mask: '.'+        palette:+          'x': [stone, pixel (B)]+        placements:+          - src: block+            offset: [0, 1]+          - src: micro+            offset: [-2, 0]+        map: |+          ..x+          ..x+          ..x+    - name: final+      structure:+        mask: '.'+        palette:+          'x': [stone, pixel (G)]+        placements:+          - src: master+        map: |+          x+          x+          x+          x+  dsl: |+    overlay+    [ {grass}+    , mask (y > -4 && y < 4 || x > -4 && x < 4) {stone}+    , mask (y > -2 && y < 2 || x > -2 && x < 2) {ice}+    , mask (y > -1 && y < 1 || x > -1 && x < 1) {dirt}+    ]+  mask: '.'+  placements:+    - src: final+      offset: [0, 0]+  upperleft: [0, 0]+  map: ""
+ data/scenarios/Testing/1780-structure-merge-expansion/sequential-placement.yaml view
@@ -0,0 +1,95 @@+version: 1+name: Flipped structure placement+author: Karl Ostmo+description: |+  Sequentially place structures that are larger than the map+  with flipped orientation.+robots:+  - name: base+    dir: north+creative: true+objectives:+  - goal:+      - Must have 3 of each color visible+    condition: |+      def countColor = \e.+        resonate e ((-6, 0), (4, -4));+        end;++      as base {+        r <- countColor "pixel (R)";+        g <- countColor "pixel (G)";+        b <- countColor "pixel (B)";+        y <- countColor "gold";+        pure $ r == 3 && g == 3 && b == 3 && y == 3;+      }+solution: |+  noop+known: [boulder, log, pixel (R), pixel (G), pixel (B), gold]+world:+  structures:+    - name: reddish+      structure:+        mask: '.'+        palette:+          'x': [stone, pixel (R)]+        map: |+          xx+          x.+    - name: greenish+      structure:+        mask: '.'+        palette:+          'x': [stone, pixel (G)]+        map: |+          xx+          x.+    - name: bluish+      structure:+        mask: '.'+        palette:+          'x': [stone, pixel (B)]+        map: |+          xx+          x.+    - name: goldish+      structure:+        mask: '.'+        palette:+          'x': [stone, gold]+        map: |+          xx+          x.+    - name: block+      structure:+        mask: '.'+        palette:+          'x': [ice, log]+        placements:+          - src: greenish+            orient:+              flip: true+            offset: [-3, 2]+          - src: reddish+            offset: [-6, 0]+          - src: goldish+            orient:+              flip: true+            offset: [3, -1]+          - src: bluish+            offset: [0, 1]+        map: |+          xxx+          xx.+          x..+  palette:+    'Ω': [grass, erase, base]+  mask: '.'+  placements:+    - src: block+      offset: [0, -2]+  upperleft: [0, 0]+  dsl: |+    {grass}+  map: |+    Ω
+ data/scenarios/Testing/1780-structure-merge-expansion/simultaneous-north-and-west-offset.yaml view
@@ -0,0 +1,56 @@+version: 1+name: Northwest sibling structure coordinate offsets+author: Karl Ostmo+description: |+  Make sure that the second sibling is displayed correctly when there+  is a simultaneous negative-x and positive-y offset on the first sibling.+robots:+  - name: base+    dir: north+    loc: [0, 2]+objectives:+  - goal:+      - Enjoy the view.+    condition: |+      pure true+solution: |+  noop+known: [pixel (R), gold]+world:+  structures:+    - name: micro+      structure:+        mask: '.'+        palette:+          'x': [stone, gold]+        map: |+          x+    - name: block+      structure:+        mask: '.'+        palette:+          'x': [stone, pixel (R)]+        map: |+          xx+          xx+    - name: master+      structure:+        mask: '.'+        placements:+          - src: micro+            offset: [-1, 1]+          - src: block+        map: ""+  dsl: |+    overlay+    [ {grass}+    , mask (y > -4 && y < 4 || x > -4 && x < 4) {stone}+    , mask (y > -2 && y < 2 || x > -2 && x < 2) {ice}+    , mask (y > -1 && y < 1 || x > -1 && x < 1) {dirt}+    ]+  mask: '.'+  placements:+    - src: master+      offset: [0, 0]+  upperleft: [0, 0]+  map: ""
data/scenarios/Testing/201-require/00-ORDER.txt view
@@ -1,8 +1,8 @@ 201-require-device.yaml 201-require-device-creative.yaml 201-require-device-creative1.yaml-201-require-entities.yaml-201-require-entities-def.yaml+201-stock-entities.yaml+201-stock-entities-def.yaml 533-reprogram-simple.yaml 533-reprogram.yaml 1664-require-system-robot-children.yaml
data/scenarios/Testing/201-require/1664-require-system-robot-children.yaml view
@@ -11,9 +11,9 @@   - condition: |       try {         robotnamed "childbot";-        return true;+        pure true;       } {-        return false;+        pure false;       } solution: |   noop;
data/scenarios/Testing/201-require/201-require-device-creative.yaml view
@@ -11,8 +11,8 @@         boatEquipped <- as r {equipped "boat"};         b1 <- as r {count "boat"};         b0 <- as base {count "boat"};-        return (p == (2,0) && b0 == 0 && boatEquipped && b1 == 0);-      } { return false }+        pure (p == (2,0) && b0 == 0 && boatEquipped && b1 == 0);+      } { pure false } creative: true solution: |   build {require "boat"; move; move}@@ -28,14 +28,9 @@   palette:     '.': [grass]     '~': [dirt, water]-    '┌': [stone, upper left corner]-    '┐': [stone, upper right corner]-    '└': [stone, lower left corner]-    '┘': [stone, lower right corner]-    '─': [stone, horizontal wall]-    '│': [stone, vertical wall]+    '+': [stone, wall]   upperleft: [-1, 1]   map: |-    ┌───┐-    │.~.│-    └───┘+    ++++++    +.~.++    +++++
data/scenarios/Testing/201-require/201-require-device-creative1.yaml view
@@ -11,8 +11,8 @@         boatEquipped <- as r {equipped "boat"};         b1 <- as r {count "boat"};         b0 <- as base {count "boat"};-        return (p == (2,0) && b0 == 1 && boatEquipped && b1 == 0);-      } { return false }+        pure (p == (2,0) && b0 == 1 && boatEquipped && b1 == 0);+      } { pure false } creative: true solution: |   build {require "boat"; move; move}@@ -29,17 +29,12 @@   palette:     '.': [grass]     '~': [dirt, knownwater]-    '┌': [stone, upper left corner]-    '┐': [stone, upper right corner]-    '└': [stone, lower left corner]-    '┘': [stone, lower right corner]-    '─': [stone, horizontal wall]-    '│': [stone, vertical wall]+    '+': [stone, wall]   upperleft: [-1, 1]   map: |-    ┌───┐-    │.~.│-    └───┘+    ++++++    +.~.++    +++++ entities:   - name: knownwater     display:
data/scenarios/Testing/201-require/201-require-device.yaml view
@@ -11,8 +11,8 @@         boatEquipped <- as r {equipped "boat"};         b1 <- as r {count "boat"};         b0 <- as base {count "boat"};-        return (p == (2,0) && b0 == 0 && boatEquipped && b1 == 0);-      } { return false }+        pure (p == (2,0) && b0 == 0 && boatEquipped && b1 == 0);+      } { pure false } solution: |   build {require "boat"; move; require "boat"; move} robots:@@ -31,14 +31,9 @@   palette:     '.': [grass]     '~': [dirt, water]-    '┌': [stone, upper left corner]-    '┐': [stone, upper right corner]-    '└': [stone, lower left corner]-    '┘': [stone, lower right corner]-    '─': [stone, horizontal wall]-    '│': [stone, vertical wall]+    '+': [stone, wall]   upperleft: [-1, 1]   map: |-    ┌───┐-    │.~.│-    └───┘+    ++++++    +.~.++    +++++
− data/scenarios/Testing/201-require/201-require-entities-def.yaml 
@@ -1,45 +0,0 @@-version: 1-name: Require entities with definition-description: |-  Require some entities using the 'require' command, and a definition.-  https://github.com/swarm-game/swarm/issues/201-objectives:-  - condition: |-      try {-        r <- robotNumbered 1;-        p <- as r {whereami};-        r1 <- as r {count "rock"};-        r0 <- as base {count "rock"};-        return (p == (4,0) && r0 == 5 && r1 == 1);-      } { return false }-solution: |-  def mp = move; place "rock" end;-  build { log "hi"; require 5 "rock"; mp; mp; mp; mp }-robots:-  - name: base-    loc: [0, 0]-    dir: east-    devices:-      - 3D printer-      - logger-      - dictionary-    inventory:-      - [10, rock]-      - [1, solar panel]-      - [1, treads]-      - [1, grabber]-      - [1, logger]-world:-  palette:-    '.': [grass]-    '┌': [stone, upper left corner]-    '┐': [stone, upper right corner]-    '└': [stone, lower left corner]-    '┘': [stone, lower right corner]-    '─': [stone, horizontal wall]-    '│': [stone, vertical wall]-  upperleft: [-1, 1]-  map: |-    ┌─────┐-    │.....│-    └─────┘
− data/scenarios/Testing/201-require/201-require-entities.yaml 
@@ -1,43 +0,0 @@-version: 1-name: Require entities-description: |-  Require some entities using the 'require' command.-  https://github.com/swarm-game/swarm/issues/201-objectives:-  - condition: |-      try {-        r <- robotNumbered 1;-        r1 <- as r {count "rock"};-        r0 <- as base {count "rock"};-        return (r0 == 5 && r1 == 3);-      } { return false }-solution: |-  build { require 5 "rock"; move; place "rock"; move; place "rock" }-robots:-  - name: base-    loc: [0, 0]-    dir: east-    devices:-      - 3D printer-      - logger-      - dictionary-    inventory:-      - [10, rock]-      - [1, solar panel]-      - [1, treads]-      - [1, grabber]-      - [1, logger]-world:-  palette:-    '.': [grass]-    '┌': [stone, upper left corner]-    '┐': [stone, upper right corner]-    '└': [stone, lower left corner]-    '┘': [stone, lower right corner]-    '─': [stone, horizontal wall]-    '│': [stone, vertical wall]-  upperleft: [-1, 1]-  map: |-    ┌───┐-    │...│-    └───┘
+ data/scenarios/Testing/201-require/201-stock-entities-def.yaml view
@@ -0,0 +1,40 @@+version: 1+name: Stock entities with definition+description: |+  Stock some entities using the 'stock' command, and a definition.+  https://github.com/swarm-game/swarm/issues/201+objectives:+  - condition: |+      try {+        r <- robotNumbered 1;+        p <- as r {whereami};+        r1 <- as r {count "rock"};+        r0 <- as base {count "rock"};+        pure (p == (4,0) && r0 == 5 && r1 == 1);+      } { pure false }+solution: |+  def mp = move; place "rock" end;+  build { log "hi"; stock 5 "rock"; mp; mp; mp; mp }+robots:+  - name: base+    loc: [0, 0]+    dir: east+    devices:+      - 3D printer+      - logger+      - dictionary+    inventory:+      - [10, rock]+      - [1, solar panel]+      - [1, treads]+      - [1, grabber]+      - [1, logger]+world:+  palette:+    '.': [grass]+    '+': [stone, wall]+  upperleft: [-1, 1]+  map: |+    ++++++++    +.....++    +++++++
+ data/scenarios/Testing/201-require/201-stock-entities.yaml view
@@ -0,0 +1,38 @@+version: 1+name: Stock entities+description: |+  Stock some entities using the 'stock' command.+  https://github.com/swarm-game/swarm/issues/201+objectives:+  - condition: |+      try {+        r <- robotNumbered 1;+        r1 <- as r {count "rock"};+        r0 <- as base {count "rock"};+        pure (r0 == 5 && r1 == 3);+      } { pure false }+solution: |+  build { stock 5 "rock"; move; place "rock"; move; place "rock" }+robots:+  - name: base+    loc: [0, 0]+    dir: east+    devices:+      - 3D printer+      - logger+      - dictionary+    inventory:+      - [10, rock]+      - [1, solar panel]+      - [1, treads]+      - [1, grabber]+      - [1, logger]+world:+  palette:+    '.': [grass]+    '+': [stone, wall]+  upperleft: [-1, 1]+  map: |+    ++++++    +...++    +++++
data/scenarios/Testing/201-require/533-reprogram-simple.yaml view
@@ -19,12 +19,12 @@         solarEquipped <- as fred {equipped "solar panel"};         treadsEquipped <- as fred {equipped "treads"}; -        return (p == (2,0)+        pure (p == (2,0)                 && boatEquipped && drillEquipped && solarEquipped && treadsEquipped                 && base_boats == 1 && base_solar == 1                 && base_treads == 1 && base_drills == 1                );-      } { return false }+      } { pure false } solution: |   fred <- build {require "boat"; setname "fred"};   wait 5;@@ -49,14 +49,9 @@   palette:     '.': [grass]     '~': [dirt, water]-    '┌': [stone, upper left corner]-    '┐': [stone, upper right corner]-    '└': [stone, lower left corner]-    '┘': [stone, lower right corner]-    '─': [stone, horizontal wall]-    '│': [stone, vertical wall]+    '+': [stone, wall]   upperleft: [-1, 1]   map: |-    ┌───┐-    │.~.│-    └───┘+    ++++++    +.~.++    +++++
data/scenarios/Testing/201-require/533-reprogram.yaml view
@@ -19,16 +19,16 @@         drillEquipped <- as fred {equipped "metal drill"};         fred_rocks <- as fred {count "rock"}; -        return (p == (2,0) && boatEquipped && drillEquipped+        pure (p == (2,0) && boatEquipped && drillEquipped                 && base_boats == 1 && base_solar == 1                 && base_treads == 1 && base_drills == 1                 && base_rocks == 42 && fred_rocks == 8                );-      } { return false }+      } { pure false } solution: |-  fred <- build {require "boat"; require 5 "rock"; setname "fred"};+  fred <- build {require "boat"; stock 5 "rock"; setname "fred"};   wait 5;-  reprogram fred {require "boat"; require "metal drill"; move; require 3 "rock"; move; require 5 "rock"}+  reprogram fred {require "boat"; require "metal drill"; move; stock 3 "rock"; move; stock 5 "rock"} robots:   - name: base     loc: [0, 0]@@ -49,14 +49,9 @@   palette:     '.': [grass]     '~': [dirt, water]-    '┌': [stone, upper left corner]-    '┐': [stone, upper right corner]-    '└': [stone, lower left corner]-    '┘': [stone, lower right corner]-    '─': [stone, horizontal wall]-    '│': [stone, vertical wall]+    '+': [stone, wall]   upperleft: [-1, 1]   map: |-    ┌───┐-    │.~.│-    └───┘+    ++++++    +.~.++    +++++
+ data/scenarios/Testing/2085-toplevel-mask.yaml view
@@ -0,0 +1,44 @@+version: 1+name: Toplevel palette mask+description: |+  Demo equivalence of 'blank' terrain and+  the 'mask' property for producing transparent cells.+seed: 0+objectives:+  - goal:+      - |+        `grab` a `flower`{=entity}.+    condition: |+      as base {has "flower"};+solution: |+  move; move; grab;+robots:+  - name: base+    dir: east+    devices:+      - treads+      - logger+      - grabber+known: [water, flower]+world:+  dsl: |+    overlay [+      {grass},+      mask ((x + y) % 2 == 0) {flower}+    ]+  upperleft: [-4, 4]+  mask: x+  palette:+    'B': [stone, erase, base]+    '.': [stone, erase]+    'y': [blank]+  map: |-+    yyy...xxx+    y.......x+    y.......x+    .........+    ....Bxxxx+    .........+    x.......y+    x.......y+    xxx...yyy
+ data/scenarios/Testing/2086-structure-palette.yaml view
@@ -0,0 +1,54 @@+version: 1+name: Structure markers+description: |+  Reference structures in the palette+seed: 0+objectives:+  - goal:+      - |+        `grab` a `tree`{=entity}.+    condition: |+      as base {has "tree"};+solution: |+  move; move; grab;+robots:+  - name: base+    dir: east+    devices:+      - treads+      - logger+      - grabber+structures:+  - name: rect+    structure:+      palette:+        'o': [dirt, tree]+      map: |+        ooo+        ooo+known: [water, tree]+world:+  dsl: |+    {grass}+  palette:+    'B': [stone, erase, base]+    '.': [stone]+    'x':+      structure:+        name: rect+      cell: [grass]+    'z':+      structure:+        name: rect+        orientation:+          up: east+      cell: [grass]+  map: |-+    ......+    ...z..+    ......+    .B....+    ......+    .x....+    ......+    ......
+ data/scenarios/Testing/2239-custom-entity.yaml view
@@ -0,0 +1,42 @@+version: 1+name: Custom entity+description: |+  Custom entity overriding standard entity+creative: false+objectives:+  - goal:+      - Move to (1,0)+    condition: |+      as base {+        loc <- whereami;+        pure $ loc == (1,0)+      };+entities:+  - name: rock+    display:+      char: '$'+      attr: gold+    description:+      - Not your average rock!+    properties: [pickable]+    capabilities: [move]+robots:+  - name: base+    dir: east+    devices:+      - logger+      - grabber+      - welder+solution: |+  grab;+  equip "rock";+  move+known: [rock]+world:+  dsl: |+    {grass}+  palette:+    'B': [grass, rock, base]+  upperleft: [0, 0]+  map: |+    B
+ data/scenarios/Testing/2240-overridden-entity-capabilities.yaml view
@@ -0,0 +1,49 @@+version: 1+name: Overridden entity capabilities+description: |+  Overridden standard entity should not still be suggested for its+  capabilities. The error message should suggest "- tank treads", not+  "- treads or tank treads".+creative: false+objectives:+  - goal:+      - Place a rock+    condition: |+      as base {+        isHere "rock"+      };+entities:+  - name: treads+    display:+      char: '#'+      attr: red+    description:+      - Broken treads+    properties: [known, pickable]+robots:+  - name: base+    dir: east+    devices:+      - logger+      - clock+      - grabber+    inventory:+      - [1, rock]+  - name: crasher+    dir: east+    devices:+      - logger+      - treads+    program: |+      move+solution: |+  wait 5; place "rock"+world:+  dsl: |+    {grass}+  palette:+    'C': [grass, null, crasher]+    'B': [grass, null, base]+  upperleft: [0, 0]+  map: |+    BC
+ data/scenarios/Testing/2253-halt-waiting.yaml view
@@ -0,0 +1,27 @@+version: 1+name: Halt a waiting robot+description: |+  Calling `halt` on a waiting robot should make it immediately idle,+  so it can e.g. be `reprogram`med+creative: true+objectives:+  - goal:+      - Get some gold+    condition: |+      as base { has "gold" };+robots:+  - name: base+    dir: north+    devices:+      - logger+solution: |+  r <- build {move; wait 10000};+  wait 2;+  halt r; wait 1; reprogram r {create "gold"; give base "gold"}+world:+  dsl: |+    {grass}+  palette:+    'B': [grass, null, base]+  map: |+    B
+ data/scenarios/Testing/2270-instant-defs.yaml view
@@ -0,0 +1,42 @@+version: 1+name: Instant wrapped defs+description: |+  `instant` should work when wrapped around definitions+creative: false+objectives:+  - goal:+      - Grab the rock+    condition: |+      as base { has "rock" }+robots:+  - name: base+    dir: east+    devices:+      - logger+      - treads+      - grabber+  - name: judge+    dir: east+    system: true+    program: |+      instant (+      def fib : Int -> Int = \n.+        if (n <= 1) {n} {fib (n-1) + fib (n-2)}+      end++      def x = fib 10 end++      create "rock"; place "rock"+      )+solution: |+  move; grab+known: [rock]+world:+  dsl: |+    {grass}+  palette:+    'B': [grass, null, base]+    'j': [grass, null, judge]+  upperleft: [0, 0]+  map: |+    Bj
data/scenarios/Testing/231-requirements/231-command-transformer-reqs.yaml view
@@ -4,7 +4,7 @@   A function transforming a command correctly accumulates requirements. creative: false solution: |-  def pr = require 1 "rock"; move; place "rock" end+  def pr = stock 1 "rock"; move; place "rock" end   def x4 = \c. c;c;c;c end   build {x4 pr} objectives:
data/scenarios/Testing/373-drill.yaml view
@@ -9,8 +9,8 @@         i <- as base {has "iron ore"};         c <- as base {has "copper ore"};         s <- as base {has "rock"};-        return (i && c && s)-      } { return false }+        pure (i && c && s)+      } { pure false } solution: |   build {     move; drill forward; turn back; move; turn left;@@ -49,23 +49,18 @@     '~': [ice, wavy water]     'L': [grass, Linux]     'T': [grass, tree]-    '┌': [stone, upper left corner]-    '┐': [stone, upper right corner]-    '└': [stone, lower left corner]-    '┘': [stone, lower right corner]-    '─': [stone, horizontal wall]-    '│': [stone, vertical wall]+    '+': [stone, wall]     'A': [stone, mountain]     'C': [stone, copper vein]     '@': [stone, boulder]     'I': [stone, iron vein]   upperleft: [-1, 1]   map: |-    ┌─────┐                                                                ~~-    │IAAT~                                                                ~L~-    │..@AA│                                                                ~~-    │Ω...C│                                                                 ~-    └─────┘                                                                 ~+    +++++++                                                                ~~+    +IAAT~                                                                ~L~+    +..@AA+                                                                ~~+    +Ω...C+                                                                 ~+    +++++++                                                                 ~ entities:   - name: copper vein     display:
data/scenarios/Testing/378-objectives.yaml view
@@ -10,12 +10,12 @@     condition: |       try {         n <- as base {count "tree"};-        return (n >= 3)-      } { return false }+        pure (n >= 3)+      } { pure false }   - goal:       - Nice job.  Now, build a harvester.     condition: |-      try { as base {has "harvester"} } {return false}+      try { as base {has "harvester"} } {pure false}     prerequisite: get_trees solution: |   build {turn right; move; move; grab; move; grab; move; grab; turn back; move; move; move; move};@@ -50,14 +50,9 @@     'Ω': [grass, null, base]     '.': [grass]     'T': [grass, tree]-    '┌': [stone, upper left corner]-    '┐': [stone, upper right corner]-    '└': [stone, lower left corner]-    '┘': [stone, lower right corner]-    '─': [stone, horizontal wall]-    '│': [stone, vertical wall]+    '+': [stone, wall]   upperleft: [-1, 1]   map: |-    ┌────────┐-    │Ω.TTTTTT│-    └────────┘+    +++++++++++    +Ω.TTTTTT++    ++++++++++
data/scenarios/Testing/394-build-drill.yaml view
@@ -7,12 +7,12 @@ objectives:   - condition: |       try {-        as base {l <- has "detonator"; return (not l)}-      } { return false }+        as base {l <- has "detonator"; pure (not l)}+      } { pure false } # When testing, add `s <- build {...}; n <- as s {whoami}; log n` solution: |   def forever = \c. c ; forever c end;-  def unblock = try {drill forward; return ()} {} end;+  def unblock = try {drill forward; pure ()} {} end;   def doPush = unblock; move end;   log "Hi, I am base";   r <- build {@@ -44,14 +44,9 @@   palette:     '.': [grass]     'M': [stone, mountain]-    '┌': [stone, upper left corner]-    '┐': [stone, upper right corner]-    '└': [stone, lower left corner]-    '┘': [stone, lower right corner]-    '─': [stone, horizontal wall]-    '│': [stone, vertical wall]+    '+': [stone, wall]   upperleft: [-1, 1]   map: |-    ┌───┐-    │..M│-    └───┘+    ++++++    +..M++    +++++
data/scenarios/Testing/397-wrong-missing.yaml view
@@ -8,7 +8,7 @@   https://github.com/swarm-game/swarm/issues/397 objectives:   - condition: |-      t <- time; return (t == 2)+      t <- time; pure (t == 2)     goal:       - |         This is a dummy condition that just ensures the base has had
data/scenarios/Testing/428-drowning-destroy.yaml view
@@ -8,13 +8,13 @@       def isAlive = \n. try {         _ <- robotNamed n;         log ("Is alive: " ++ n);-        return true-      } { return false } end;+        pure true+      } { pure false } end;       try {         baseAlive <- isAlive "base";         botAlive <- isAlive "bot";-        return (baseAlive && not botAlive);-      } { return false; }+        pure (baseAlive && not botAlive);+      } { pure false; } solution: |   log "start";   wait 5;@@ -37,15 +37,10 @@   palette:     '.': [grass]     ' ': [ice, water]-    '┌': [stone, upper left corner]-    '┐': [stone, upper right corner]-    '└': [stone, lower left corner]-    '┘': [stone, lower right corner]-    '─': [stone, horizontal wall]-    '│': [stone, vertical wall]+    '+': [stone, wall]   upperleft: [-1, 1]   map: |-    ┌──┐-    │. │-    │. │-    └──┘+    +++++    +. ++    +. ++    ++++
data/scenarios/Testing/475-wait-one.yaml view
@@ -11,9 +11,9 @@       try {         teleport self (0,0);         ishere "lambda"-      } { return false }+      } { pure false } solution: |-  log "I will win next tick!"; place "lambda";+  log "I will win next tick!"; wait 1; place "lambda"; robots:   - name: base     loc: [0, 0]@@ -21,6 +21,7 @@     devices:       - logger       - grabber+      - clock     inventory:       - [1, lambda]   - name: sleeper@@ -30,21 +31,16 @@       - logger       - clock     program: |-      log "I shall sleep"; wait 1; log "I have awoken"+      log "I shall sleep"; wait 2; log "I have awoken" world:   palette:     '.': [grass]-    '┌': [stone, upper left corner]-    '┐': [stone, upper right corner]-    '└': [stone, lower left corner]-    '┘': [stone, lower right corner]-    '─': [stone, horizontal wall]-    '│': [stone, vertical wall]+    '+': [stone, wall]     'λ': [grass, lambda]   upperleft: [-1, 1]   map: |-    ┌─────┐-    │..λ..│-    │....λ│-    │...λ.│-    └─────┘+    ++++++++    +..λ..++    +....λ++    +...λ.++    +++++++
data/scenarios/Testing/479-atomic-race.yaml view
@@ -28,7 +28,7 @@       try {         p <- robotNamed "planter";         as p {has "Win"}-      } { return false }+      } { pure false } solution: |   def forever = \c. force c ; forever c end   def tryharvest =
data/scenarios/Testing/479-atomic.yaml view
@@ -11,14 +11,14 @@   - condition: |       try {         p <- robotNamed "planter";-        as p {n <- count "weed"; return (n == 0)}-      } { return false }+        as p {n <- count "weed"; pure (n == 0)}+      } { pure false } solution: |   def forever = \c. force c ; forever c end   def tryharvest =     atomic (       b <- ishere "weed";-      if b {harvest; return ()} {}+      if b {harvest; pure ()} {}     );     n <- random 4; wait n   end;
data/scenarios/Testing/490-harvest.yaml view
@@ -11,9 +11,9 @@         t1 <- ishere "tree";         move;         t2 <- ishere "tree";-        t3 <- as base {n <- count "water"; return (n == 4)};-        return (t1 && not t2 && t3)-      } { return false }+        t3 <- as base {n <- count "water"; pure (n == 4)};+        pure (t1 && not t2 && t3)+      } { pure false } solution: |   move; harvest; move; grab; turn right; move; grab; grab; harvest; grab robots:@@ -29,16 +29,11 @@   palette:     '.': [grass]     'T': [stone, tree]-    '┌': [stone, upper left corner]-    '┐': [stone, upper right corner]-    '└': [stone, lower left corner]-    '┘': [stone, lower right corner]-    '─': [stone, horizontal wall]-    '│': [stone, vertical wall]+    '+': [stone, wall]     '~': [stone, water]   upperleft: [-1, 1]   map: |-    ┌───┐-    │.TT│-    │~~~│-    └───┘+    ++++++    +.TT++    +~~~++    +++++
data/scenarios/Testing/504-teleport-self.yaml view
@@ -9,7 +9,7 @@         create "tree"; place "tree";         teleport self (5,0);         ishere "tree"-      } { return false }+      } { pure false } solution: |   place "tree" robots:@@ -25,14 +25,9 @@ world:   palette:     '.': [grass]-    '┌': [stone, upper left corner]-    '┐': [stone, upper right corner]-    '└': [stone, lower left corner]-    '┘': [stone, lower right corner]-    '─': [stone, horizontal wall]-    '│': [stone, vertical wall]+    '+': [stone, wall]   upperleft: [-1, 1]   map: |-    ┌──────┐-    │......│-    └──────┘+    +++++++++    +......++    ++++++++
data/scenarios/Testing/508-capability-subset.yaml view
@@ -10,8 +10,8 @@         p <- as r {whereami};         g <- as base {count "GPS"};         t <- as base {count "Tardis"};-        return (p == (5,0) && g == 1 && t == 0);-      } { return false }+        pure (p == (5,0) && g == 1 && t == 0);+      } { pure false } solution: |   log "Hi, I can build teleporting robots!";   try {@@ -42,17 +42,12 @@   palette:     '.': [grass, erase]     ' ': [ice, water]-    '┌': [stone, upper left corner]-    '┐': [stone, upper right corner]-    '└': [stone, lower left corner]-    '┘': [stone, lower right corner]-    '─': [stone, horizontal wall]-    '│': [stone, vertical wall]+    '+': [stone, wall]   upperleft: [-1, 1]   map: |-    ┌─┐  ┌─┐-    │.│  │.│-    └─┘  └─┘+    +++  ++++    +.+  +.++    +++  +++ entities:   - name: GPS     display:@@ -61,7 +56,7 @@     description:       - A satellite navigation device.     properties: [known, pickable]-    capabilities: [senseloc]+    capabilities: [whereami]   - name: Tardis     display:       attr: water@@ -69,4 +64,4 @@     description:       - Bigger on the inside.     properties: [known, pickable]-    capabilities: [senseloc, teleport]+    capabilities: [whereami, teleport]
data/scenarios/Testing/555-teleport-location.yaml view
@@ -8,7 +8,7 @@   - condition: |       try {         as base {has "rock"}-      } { return false }+      } { pure false } solution: |   fred <- robotNamed "fred";   myLoc <- whereami;
data/scenarios/Testing/562-lodestone.sw view
@@ -5,8 +5,10 @@   if b t e end; -def until = \p.\t.-  ifC p t {until p t}+def waitFor = \e.\t.+  watch down;+  wait 100;+  ifC (ishere e) t {waitFor e t} end;  def repeat = \c.@@ -29,18 +31,18 @@  // get one lodestone build {log "Hey!"; turn north; m2; l <- grab; turn back; m2; place l};-until (ishere "lodestone") {grab};+waitFor "lodestone" {grab};  // get two bit (0) build {   log "Hi!";   repeat (     log "I am going for a bit";-    turn east; m2; x <- until (ishere "bit (0)") {harvest}; turn back; m2; place x;+    turn east; m2; x <- waitFor "bit (0)" {harvest}; turn back; m2; place x; 		log "I brought a bit"; )};-until (ishere "bit (0)") {grab};-until (ishere "bit (0)") {grab};+waitFor "bit (0)" {grab};+waitFor "bit (0)" {grab};  make "bit (1)"; make "drill bit"
data/scenarios/Testing/562-lodestone.yaml view
@@ -7,7 +7,7 @@     condition: |       try {         as base {has "drill bit"};-      } { return false }+      } { pure false } solution: |   run "scenarios/Testing/562-lodestone.sw" robots:@@ -25,6 +25,7 @@       - workbench       - 3D printer       - branch predictor+      - rolex     inventory:       - [10, drill]       - [10, lambda]@@ -37,6 +38,7 @@       - [10, strange loop]       - [10, branch predictor]       - [10, toolkit]+      - [10, rolex]       - [0, drill bit]       - [0, bit (0)]       - [0, bit (1)]@@ -50,23 +52,18 @@     '~': [ice, wavy water]     'L': [grass, Linux]     'T': [grass, tree]-    '┌': [stone, upper left corner]-    '┐': [stone, upper right corner]-    '└': [stone, lower left corner]-    '┘': [stone, lower right corner]-    '─': [stone, horizontal wall]-    '│': [stone, vertical wall]+    '+': [stone, wall]     'A': [stone, magnetic vein]     'o': [stone, lodestone]     '0': [grass, bit (0)]     'B': [grass, erase, base]   upperleft: [-1, 1]   map: |-    ┌─────┐                                                                ~~-    │o.AT~                                                                ~L~-    │..AAA│                                                                ~~-    │B.0.A│                                                                 ~-    └─────┘                                                                 ~+    +++++++                                                                ~~+    +o.AT~                                                                ~L~+    +..AAA+                                                                ~~+    +B.0.A+                                                                 ~+    +++++++                                                                 ~ entities:   - name: magnetic vein     display:
data/scenarios/Testing/684-swap.yaml view
@@ -9,10 +9,10 @@         as base {           l <- has "lambda";           b <- has "bitcoin";-          return $ l && b+          pure $ l && b         }       } {-        return false+        pure false       } solution: |   swap "bitcoin"; swap "gold coin";@@ -41,20 +41,15 @@         case d (\_.           say "Fatal error: swap does not work atomically!"         ) (\_.-          return ()+          pure ()         )       ) world:   palette:-    '┌': [stone, upper left corner]-    '┐': [stone, upper right corner]-    '└': [stone, lower left corner]-    '┘': [stone, lower right corner]-    '─': [stone, horizontal wall]-    '│': [stone, vertical wall]+    '+': [stone, wall]     'λ': [grass, lambda]   upperleft: [-1, 1]   map: |-    ┌─┐-    │λ│-    └─┘+    ++++    +λ++    +++
data/scenarios/Testing/699-movement-fail/699-move-blocked.yaml view
@@ -5,12 +5,12 @@   https://github.com/swarm-game/swarm/issues/699 objectives:   - condition: |-      def isAliveOn = \name.\loc. try {r <- robotNamed name; l <- as r {whereami}; return $ l == loc} {return false} end;-      def isDead = \name. try {robotNamed name; return false} {return true} end;+      def isAliveOn = \name.\loc. try {r <- robotNamed name; l <- as r {whereami}; pure $ l == loc} {pure false} end;+      def isDead = \name. try {robotNamed name; pure false} {pure true} end;       a1 <- isAliveOn "one" (0,-1);       a2 <- isAliveOn "two" (1,-2);       b <- isAliveOn "base" (0,0);-      return (a1 && a2 && b)+      pure (a1 && a2 && b) solution: |   move; say "Fatal error: base was able to move into a boulder and not fail!" robots:@@ -34,16 +34,11 @@     'B': [grass, null, base]     '1': [grass, null, one]     '2': [grass, null, two]-    '┌': [stone, upper left corner]-    '┐': [stone, upper right corner]-    '└': [stone, lower left corner]-    '┘': [stone, lower right corner]-    '─': [stone, horizontal wall]-    '│': [stone, vertical wall]+    '+': [stone, wall]   upperleft: [-1, 1]   map: |-    ┌──┐-    │B@│-    │1@│-    │2@│-    └──┘+    +++++    +B@++    +1@++    +2@++    ++++
data/scenarios/Testing/699-movement-fail/699-move-liquid.yaml view
@@ -5,13 +5,13 @@   https://github.com/swarm-game/swarm/issues/699 objectives:   - condition: |-      def isAliveOn = \name.\loc. try {r <- robotNamed name; l <- as r {whereami}; return $ l == loc} {return false} end;-      def isDead = \name. try {robotNamed name; return false} {return true} end;+      def isAliveOn = \name.\loc. try {r <- robotNamed name; l <- as r {whereami}; pure $ l == loc} {pure false} end;+      def isDead = \name. try {robotNamed name; pure false} {pure true} end;       d1 <- isDead "one";       a2 <- isAliveOn "two" (1,-2);       a3 <- isAliveOn "three" (1,-3);       b <- isAliveOn "base" (0,0);-      return (d1 && a2 && a3 && b)+      pure (d1 && a2 && a3 && b) solution: |   move; say "Fatal error: base was able to move into water and not fail!" robots:@@ -41,17 +41,12 @@     '1': [grass, null, one]     '2': [grass, null, two]     '3': [grass, null, three]-    '┌': [stone, upper left corner]-    '┐': [stone, upper right corner]-    '└': [stone, lower left corner]-    '┘': [stone, lower right corner]-    '─': [stone, horizontal wall]-    '│': [stone, vertical wall]+    '+': [stone, wall]   upperleft: [-1, 1]   map: |-    ┌──┐-    │B~│-    │1~│-    │2~│-    │3~│-    └──┘+    +++++    +B~++    +1~++    +2~++    +3~++    ++++
data/scenarios/Testing/699-movement-fail/699-teleport-blocked.yaml view
@@ -6,14 +6,14 @@ creative: true objectives:   - condition: |-      def isAliveOn = \name.\loc. try {r <- robotNamed name; l <- as r {whereami}; return $ l == loc} {return false} end;-      def isDead = \name. try {robotNamed name; return false} {return true} end;+      def isAliveOn = \name.\loc. try {r <- robotNamed name; l <- as r {whereami}; pure $ l == loc} {pure false} end;+      def isDead = \name. try {robotNamed name; pure false} {pure true} end;       d1 <- isDead "one";       d2 <- isDead "two";       a3 <- isAliveOn "three" (3,0);       a4 <- isAliveOn "four" (3,0);       b <- isAliveOn "base" (5,0);-      return (d1 && d2 && a3 && a4 && b)+      pure (d1 && d2 && a3 && a4 && b) solution: |   o <- robotNamed "one"; reprogram o {t <- robotNamed "two"; teleport t (3,0); teleport self (3,0)};   try {teleport self (3,0)} {teleport self (5,0)}@@ -40,14 +40,9 @@     '2': [grass, null, two]     '3': [grass, null, three]     '4': [grass, null, four]-    '┌': [stone, upper left corner]-    '┐': [stone, upper right corner]-    '└': [stone, lower left corner]-    '┘': [stone, lower right corner]-    '─': [stone, horizontal wall]-    '│': [stone, vertical wall]+    '+': [stone, wall]   upperleft: [-1, 1]   map: |-    ┌──────┐-    │B12@34│-    └──────┘+    +++++++++    +B12@34++    ++++++++
data/scenarios/Testing/710-multi-robot.yaml view
@@ -26,28 +26,20 @@   palette:     '.': [blank]     # FIRST ROOM-    '┌': [blank, upper left corner]-    '└': [blank, lower left corner]-    '─': [blank, horizontal wall]-    '│': [blank, vertical wall]-    '┐': [blank, upper right corner, upright0]-    '┘': [blank, lower right corner, lowright0]+    '+': [blank, wall]+    'c': [blank, wall, corner0]     # SECOND ROOM-    '1': [blank, vertical wall, gate1]-    '-': [blank, "1", horizon]-    'u': [blank, "1", upright, upright1]-    'l': [blank, "1", lowright, lowright1]-    '2': [blank, "1", vertice, gate2]+    '1': [blank, wall, gate1]+    '-': [blank, "1", wally]+    'u': [blank, "1", wally, corner1]+    '2': [blank, "1", wally, gate2]     # THIRD ROOM-    '~': [blank, "2", horizon]-    '/': [blank, "2", vertice]-    'U': [blank, "2", upright]-    'L': [blank, "2", lowright]+    '~': [blank, "2", wally]   upperleft: [-1, 1]   map: |-    ┌────┐--u~~U-    │....1..2../-    └────┘--l~~L+    +++++c--u~~~+    +....1..2..~+    +++++c--u~~~ robots:   - name: base     dir: east@@ -67,8 +59,8 @@       until (         try {           loc <- as base {whereami};-          return (loc == l)-        } { return false }+          pure (loc == l)+        } { pure false }       );       create "Win"   - name: check2@@ -83,8 +75,8 @@       until (         try {           loc <- as base {whereami};-          return (loc == l)-        } { return false }+          pure (loc == l)+        } { pure false }       );       create "Win"   - name: check3@@ -99,114 +91,44 @@       until (         try {           loc <- as base {whereami};-          return (loc == l)-        } { return false }+          pure (loc == l)+        } { pure false }       );       create "Win"-  - name: horizon-    dir: [0, 0]-    system: true-    display:-      invisible: true-    inventory: [[1, horizontal wall]]-    program: |-      def until = \c. b <- c; if b {} {until c} end;-      n <- (s <- scan down; case s (\_. fail "Fatal error: missing room number!") return);-      c1 <- robotNamed ("check" ++ n);-      until (as c1 {has "Win"});-      swap "horizontal wall"-  - name: vertice-    dir: [0, 0]-    system: true-    display:-      invisible: true-    inventory: [[1, vertical wall]]-    program: |-      def until = \c. b <- c; if b {} {until c} end;-      n <- (s <- scan down; case s (\_. fail "Fatal error: missing room number!") return);-      c1 <- robotNamed ("check" ++ n);-      until (as c1 {has "Win"});-      swap "vertical wall"-  - name: upright-    dir: [0, 0]-    system: true-    display:-      invisible: true-    inventory: [[1, upper right corner]]-    program: |-      def until = \c. b <- c; if b {} {until c} end;-      n <- (s <- scan down; case s (\_. fail "Fatal error: missing room number!") return);-      c1 <- robotNamed ("check" ++ n);-      until (as c1 {has "Win"});-      swap "upper right corner"-  - name: lowright-    dir: [0, 0]-    system: true-    display:-      invisible: true-    inventory: [[1, lower right corner]]-    program: |-      def until = \c. b <- c; if b {} {until c} end;-      n <- (s <- scan down; case s (\_. fail "Fatal error: missing room number!") return);-      c1 <- robotNamed ("check" ++ n);-      until (as c1 {has "Win"});-      swap "lower right corner"-  - name: upleft+  - name: wally     dir: [0, 0]     system: true     display:       invisible: true-    inventory: [[1, upper left corner]]+    inventory: [[1, wall]]     program: |       def until = \c. b <- c; if b {} {until c} end;-      n <- (s <- scan down; case s (\_. fail "Fatal error: missing room number!") return);+      n <- (s <- scan down; case s (\_. fail "Fatal error: missing room number!") pure);       c1 <- robotNamed ("check" ++ n);       until (as c1 {has "Win"});-      swap "upper left corner"-  - name: upright0-    dir: [0, 0]-    system: true-    display:-      invisible: true-    inventory: [[1, down and horizontal wall]]-    program: |-      def until = \c. b <- c; if b {} {until c} end;-      c1 <- robotNamed "check1";-      until (as c1 {has "Win"});-      swap "down and horizontal wall"-  - name: lowright0+      swap "wall"+  - name: corner0     dir: [0, 0]     system: true     display:       invisible: true-    inventory: [[1, up and horizontal wall]]+    inventory: [[1, wall]]     program: |       def until = \c. b <- c; if b {} {until c} end;       c1 <- robotNamed "check1";       until (as c1 {has "Win"});-      swap "up and horizontal wall"-  - name: upright1-    dir: [0, 0]-    system: true-    display:-      invisible: true-    inventory: [[1, down and horizontal wall]]-    program: |-      def until = \c. b <- c; if b {} {until c} end;-      c1 <- robotNamed "check2";-      until (as c1 {has "Win"});-      swap "down and horizontal wall"-  - name: lowright1+      swap "wall"+  - name: corner1     dir: [0, 0]     system: true     display:       invisible: true-    inventory: [[1, up and horizontal wall]]+    inventory: [[1, wall]]     program: |       def until = \c. b <- c; if b {} {until c} end;       c1 <- robotNamed "check2";       until (as c1 {has "Win"});-      swap "up and horizontal wall"+      swap "wall"   - name: gate1     dir: [0, 0]     system: true
data/scenarios/Testing/795-prerequisite/795-prerequisite-and.yaml view
@@ -7,7 +7,7 @@   - goal:       - Achieve both of two other objectives     condition: |-      return true;+      pure true;     prerequisite:       previewable: true       logic:
data/scenarios/Testing/795-prerequisite/795-prerequisite-mutually-exclusive.yaml view
@@ -7,7 +7,7 @@   - goal:       - Either obtain a "furnace" WITHOUT a "flower", or obtain both a "wooden gear" and "flower".     condition: |-      return true;+      pure true;     prerequisite:       previewable: true       logic:
data/scenarios/Testing/795-prerequisite/795-prerequisite-or.yaml view
@@ -7,7 +7,7 @@   - goal:       - Achieve one of two other objectives     condition: |-      return true;+      pure true;     prerequisite:       previewable: true       logic:
data/scenarios/Testing/836-pathfinding/836-automatic-waypoint-navigation.yaml view
@@ -11,7 +11,7 @@     condition: |       as base {         eggCount <- count "egg";-        return $ eggCount >= 64;+        pure $ eggCount >= 64;       }; attrs:   - name: easter_egg@@ -25,13 +25,6 @@       - Enables `path` command     properties: [known, pickable]     capabilities: [path]-  - name: atlas-    display:-      char: 'a'-    description:-      - Enables `waypoint` command-    properties: [known, pickable]-    capabilities: [waypoint]   - name: kudzu     display:       char: 'k'@@ -103,12 +96,7 @@   palette:     '.': [grass]     'k': [stone, kudzu, gardener]-    '┌': [stone, upper left corner]-    '┐': [stone, upper right corner]-    '└': [stone, lower left corner]-    '┘': [stone, lower right corner]-    '─': [stone, horizontal wall]-    '│': [stone, vertical wall]+    '+': [stone, wall]   structures:     - name: cornerbox       structure:@@ -141,14 +129,14 @@       orient:         up: west   map: |-    ┌───────────┐-    │...........│-    │...........│-    │.....k.....│-    │...........│-    │...........│-    │...........│-    │.....k.....│-    │...........│-    │...........│-    └───────────┘+    ++++++++++++++    +...........++    +...........++    +.....k.....++    +...........++    +...........++    +...........++    +.....k.....++    +...........++    +...........++    +++++++++++++
data/scenarios/Testing/836-pathfinding/836-no-path-exists1.yaml view
@@ -10,7 +10,7 @@     condition: |       as base {         nextDir <- path (inL ()) (inR "flower");-        return $ case nextDir (\_. true) (\_. false);+        pure $ case nextDir (\_. true) (\_. false);       }; solution: |   noop;
data/scenarios/Testing/836-pathfinding/836-no-path-exists2.yaml view
@@ -16,7 +16,7 @@     condition: |       as base {         nextDir <- path (inL ()) (inR "flower");-        return $ case nextDir (\_. true) (\_. false);+        pure $ case nextDir (\_. true) (\_. false);       }; solution: |   noop;
data/scenarios/Testing/836-pathfinding/836-path-exists-distance-limit-reachable.yaml view
@@ -9,7 +9,7 @@     condition: |       as base {         nextDir <- path (inR 3) (inR "flower");-        return $ case nextDir (\_. false) (\_. true);+        pure $ case nextDir (\_. false) (\_. true);       }; solution: |   move;
data/scenarios/Testing/836-pathfinding/836-path-exists-distance-limit-unreachable.yaml view
@@ -9,7 +9,7 @@     condition: |       as base {         nextDir <- path (inR 3) (inR "flower");-        return $ case nextDir (\_. true) (\_. false);+        pure $ case nextDir (\_. true) (\_. false);       }; solution: |   turn back;
data/scenarios/Testing/836-pathfinding/836-path-exists-find-entity-unwalkable.yaml view
@@ -9,7 +9,7 @@     condition: |       as base {         itemAhead <- scan forward;-        return $ case itemAhead (\_. false) (\item. item == "water");+        pure $ case itemAhead (\_. false) (\item. item == "water");       }; solution: |   run "scenarios/Testing/836-pathfinding/_836-path-exists/find-entity-unwalkable-solution.sw";
data/scenarios/Testing/836-pathfinding/_836-automatic-waypoint-navigation/gardener.sw view
@@ -6,7 +6,7 @@   } {     wait 50;     harvest;-    return ();+    pure ();   };   end;
data/scenarios/Testing/836-pathfinding/_836-automatic-waypoint-navigation/patrol.sw view
@@ -1,9 +1,11 @@-def goDir = \f. \r.-  let d = fst r in+def λmatch = \f. \p. match p f end+def λcase = \f. \g. \s. case s f g end++def goDir = \f. λmatch \d. \_.   if (d == down) {     eggHere <- ishere "egg";-    if eggHere {grab; return ()} {};-    return ()+    if eggHere {grab; pure ()} {};+    pure ()   } {     turn d; @@ -19,18 +21,24 @@  def followRoute = \loc.     nextDir <- path (inL ()) (inL loc);-    case nextDir return $ goDir $ followRoute loc;+    case nextDir pure $ goDir $ followRoute loc;     end; -def visitNextWaypoint = \nextWpIdx.-    nextWaypointQuery <- waypoint "wp" nextWpIdx;-    followRoute $ snd nextWaypointQuery; -    visitNextWaypoint $ nextWpIdx + 1;+def visitNextWaypoint : (rec l. Unit + (Int * Int) * l) -> (rec l. Unit + (Int * Int) * l) -> Cmd Unit = \originalList. \remainingList.++    // Wrap around+    let myList = case remainingList (\_. originalList) (\_. remainingList) in++    case myList pure (λmatch \hd. \tl.+        followRoute hd;+        visitNextWaypoint originalList tl;+    );     end;  def go =-    visitNextWaypoint 0;+    let wps = waypoints "wp" in+    visitNextWaypoint wps wps;     end;  go;
data/scenarios/Testing/836-pathfinding/_836-automatic-waypoint-navigation/rabbit.sw view
@@ -1,5 +1,6 @@ -def visitNextWaypoint = \nextWpIdx.+def visitNextWaypoint : (rec l. Unit + (Int * Int) * l) -> (rec l. Unit + (Int * Int) * l) -> Cmd Unit = \originalList. \remainingList.+     emptyHere <- isempty;     if emptyHere {       try {@@ -7,10 +8,20 @@       } {};     } {};     watch down;-    nextWaypointQuery <- waypoint "wp" nextWpIdx;-    teleport self $ snd nextWaypointQuery;-    wait 1000;-    visitNextWaypoint $ nextWpIdx + 1;++    // Wrap around+    let myList = case remainingList (\_. originalList) (\_. remainingList) in++    case myList pure (\cons.+        match cons \wp. \tl.+        teleport self wp;+        wait 1000;++        visitNextWaypoint originalList tl;+    );++     end; -visitNextWaypoint 0;+let wps = waypoints "wp" in+visitNextWaypoint wps wps;
data/scenarios/Testing/836-pathfinding/_836-path-exists/find-entity-solution.sw view
@@ -1,7 +1,7 @@ def goDir = \f. \r.-  let d = fst r in+  match r \d. \_.   if (d == down) {-    grab; return ()+    grab; pure ()   } {     turn d; move; f;   }@@ -9,7 +9,7 @@  def followRoute =     nextDir <- path (inL ()) (inR "flower");-    case nextDir return $ goDir followRoute;+    case nextDir pure $ goDir followRoute;     end;  followRoute;
data/scenarios/Testing/836-pathfinding/_836-path-exists/find-entity-unwalkable-solution.sw view
@@ -1,13 +1,13 @@ def goDir = \goalItem. \f. \r.-  let d = fst r in+  match r \d. \_.   if (d == down) {-    grab; return ()+    grab; pure ()   } {     turn d;     itemAhead <- scan forward;     let isGoalAhead = case itemAhead (\_. false) (\item. item == goalItem) in     if isGoalAhead {-      return ();+      pure ();     } {       move; f;     };@@ -17,7 +17,7 @@ def followRoute =     let goalItem = "water" in     nextDir <- path (inL ()) (inR goalItem);-    case nextDir return $ goDir goalItem followRoute;+    case nextDir pure $ goDir goalItem followRoute;     end;  followRoute;
data/scenarios/Testing/836-pathfinding/_836-path-exists/find-location-solution.sw view
@@ -1,7 +1,7 @@ def goDir = \f. \r.-  let d = fst r in+  match r \d. \_.   if (d == down) {-    grab; return ()+    grab; pure ()   } {     turn d; move; f;   }@@ -9,7 +9,7 @@  def followRoute =     nextDir <- path (inL ()) (inL (4, 0));-    case nextDir return $ goDir followRoute;+    case nextDir pure $ goDir followRoute;     end;  followRoute;
data/scenarios/Testing/858-inventory/858-counting-objective.yaml view
@@ -12,7 +12,7 @@     condition: |-       as base {         itemCount <- count "tree";-        return $ itemCount > 0;+        pure $ itemCount > 0;       }; robots:   - name: base
data/scenarios/Testing/858-inventory/858-nonpossession-objective.yaml view
@@ -10,7 +10,7 @@     condition: |-       as base {         x <- has "tree";-        return $ not x;+        pure $ not x;       }; robots:   - name: base
data/scenarios/Testing/920-meet.yaml view
@@ -10,20 +10,20 @@       teleport self (0,0);       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})+          (\_. pure true)+          (\cons. match cons \hd. \tl. b <- f hd; if b {all tl f} {pure false})       end;       rs <- meetAll;       b1 <- all rs (\r. as r {has "boat"});       n2 <- as r0 { count "boat" };-      return (b0 && b1 && (n2 == 2))+      pure (b0 && b1 && (n2 == 2)) solution: |   mr0 <- meet;-  case mr0 (\_. return ()) (\r0. give r0 "boat");+  case mr0 (\_. pure ()) (\r0. give r0 "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)+      (\_. pure ())+      (\cons. match cons \hd. \tl. f hd; forM_ tl f)   end;   rs <- meetAll;   forM_ rs (\r. give r "boat")@@ -48,16 +48,11 @@     '.': [grass]     'Ω': [grass, null]     'o': [grass, null, other]-    '┌': [stone, upper left corner]-    '┐': [stone, upper right corner]-    '└': [stone, lower left corner]-    '┘': [stone, lower right corner]-    '─': [stone, horizontal wall]-    '│': [stone, vertical wall]+    '+': [stone, wall]   upperleft: [-2, 2]   map: |-    ┌───┐-    │.o.│-    │oΩo│-    │.o.│-    └───┘+    ++++++    +.o.++    +oΩo++    +.o.++    +++++
data/scenarios/Testing/955-heading.yaml view
@@ -7,7 +7,7 @@   - condition: |       loc <- as base {whereami};       h <- as base {heading};-      return $ loc == (1,-1) && h == north+      pure $ loc == (1,-1) && h == north solution: |   h <- heading; turn east; move; move; turn right; move; move; turn h robots:
data/scenarios/Testing/956-GPS.yaml view
@@ -6,7 +6,7 @@ objectives:   - condition: |       loc <- as base {whereami};-      return $ loc == (0,0)+      pure $ loc == (0,0)     goal:       - |         The goal is to move back to the origin after being@@ -18,8 +18,9 @@   def abs = \n. if (n<0) {-n} {n} end;   wait 2;   loc <- whereami;-  turn (if (fst loc < 0) {east} {west}); x (abs (fst loc)) move;-  turn (if (snd loc < 0) {north} {south}); x (abs (snd loc)) move;+  match loc \locx. \locy.+  turn (if (locx < 0) {east} {west}); x (abs locx) move;+  turn (if (locy < 0) {north} {south}); x (abs locy) move; robots:   - name: base     dir: north
data/scenarios/Testing/961-custom-capabilities.yaml view
@@ -7,7 +7,7 @@ objectives:   - condition: |       mover <- robotNumbered 1;-      as mover { loc <- whereami; return $ loc == (0,1) }+      as mover { loc <- whereami; pure $ loc == (0,1) }     goal:       - |         Get a robot to (0,1)!
data/scenarios/Testing/Achievements/RobotIntoWater.yaml view
@@ -6,14 +6,14 @@     goal:       - Build a robot     condition: |-      try {robotNumbered 1; return True} {return False}+      try {robotNumbered 1; pure True} {pure False}   - goal:       - Drown it     prerequisite: build     condition: |-      try {robotNumbered 1; return False} {return True}+      try {robotNumbered 1; pure False} {pure True} solution: |-  build { turn right; move; move; move }+  build { turn left; move; move; move; move; move; move } robots:   - name: base     loc: [0, 0]@@ -43,6 +43,5 @@       - [5, toolkit] seed: 0 world:-  offset: true   dsl: |     "classic"
+ data/scenarios/Testing/_Validation/2077-mask-char.yaml view
@@ -0,0 +1,14 @@+version: 1+name: Mask char palette overlap+description: |+  Ensure mask char is not used as a palette key+robots: []+world:+  mask: q+  palette:+    '.': [grass]+    'q': [dirt]+  upperleft: [0, 0]+  map: |+    ..+    ..
+ data/scenarios/Testing/_Validation/2077-palette-chars.yaml view
@@ -0,0 +1,14 @@+version: 1+name: Enforce single-char palette keys+description: |+  No multiple-char or zero-length entries allowed.+robots: []+world:+  palette:+    '.': [grass]+    '': [stone]+    'foo': [dirt]+  upperleft: [0, 0]+  map: |+    ..+    ..
+ data/scenarios/Testing/_Validation/2164-recursive-structure.yaml view
@@ -0,0 +1,43 @@+version: 1+name: Structure placement (recursive references)+description: |+  Recursive structure references are not allowed.+robots:+  - name: base+    loc: [2, 2]+    dir: east+known: []+world:+  structures:+    - name: bigbox+      structure:+        structures:+          - name: bitpair+            structure:+              palette:+                '.': [stone, tree]+              placements:+                - src: minibox+              map: |+                .+          - name: minibox+            structure:+              palette:+                '.': [stone]+              placements:+                - src: bitpair+              map: |+                .+        placements:+          - src: smallbox+          - src: bitpair+        map: ""+    - name: smallbox+      structure:+        palette:+          '.': [grass]+        map: |+          .+  placements:+    - src: bigbox+  map: ""
+ data/scenarios/Testing/_Validation/2198-prerequisite-SCC.yaml view
@@ -0,0 +1,38 @@+version: 1+name: |+  Prerequisite objectives: dependency cycles in a larger SCC+author: Brent Yorgey+description: |+  This should be rejected by the parser due to cyclic dependencies.+  The dependency graph is strongly connected, but not all four+  dependencies are in a single cycle together.+robots:+  - name: base+objectives:+  - id: a+    condition: 'true'+    prerequisite:+      logic:+        and:+          - b+          - c+          - d+  - id: b+    condition: 'true'+    prerequisite: a+  - id: c+    condition: 'true'+    prerequisite:+      logic:+        and:+          - a+          - d+  - id: d+    condition: 'true'+    prerequisite:+      logic:+        and:+          - a+          - c+world:+  dsl: '{stone}'
+ data/scenarios/Testing/_Validation/2236-unparseable-attr-color.yaml view
@@ -0,0 +1,25 @@+version: 1+name: Custom attribute - invalid color+description: |+  Invalid color in custom attribute+creative: false+attrs:+  - name: bogus+    bg: "this is not a color"+terrains:+  - name: whatzit+    attr: bogus+    description: |+      A thingy+robots:+  - name: base+    dir: east+world:+  dsl: |+    {grass}+  palette:+    'B': [grass, null, base]+    '.': [whatzit]+  upperleft: [0, 0]+  map: |+    B.
data/scenarios/Testing/_Validation/795-prerequisite-nonexistent-reference.yaml view
@@ -7,7 +7,7 @@   - goal:       - Achieve one of two other objectives     condition: |-      return true;+      pure true;     prerequisite: shave_furnace   - id: have_furnace     goal:
data/scenarios/Tutorials/00-ORDER.txt view
@@ -8,13 +8,13 @@ equip.yaml build.yaml bind2.yaml-crash.yaml+debug.yaml scan.yaml give.yaml def.yaml lambda.yaml require.yaml-requireinv.yaml+stock.yaml conditionals.yaml world101.yaml farming.yaml
data/scenarios/Tutorials/backstory.yaml view
@@ -18,7 +18,7 @@       try {         l <- robotNamed "listener";         as l {has "READY"}-      } { return false }+      } { pure false } solution: |   say "Ready!" entities:@@ -38,7 +38,6 @@     properties: [known, pickable] robots:   - name: base-    system: true     display:       char: 'Ω'       attr: robot@@ -72,8 +71,8 @@         } {log "Something bad happened!"}       } seed: 0+creative: true world:-  offset: true   scrollable: false   dsl: |     "classic"
data/scenarios/Tutorials/bind2.yaml view
@@ -11,67 +11,57 @@         A pedestal stands conspicuously empty in the center of the room.         Perhaps its intended contents lie nearby?       - |-        Build a robot to retrieve and restore the mystery artifact to its proper place!-      - |-        **NOTE:** If you find yourself stuck, you can select "Start over" from-        the "Quit" (**Ctrl+Q**) dialog.-    condition: |-      try {-        p <- robotnamed "floorspot";-        w <- as p {ishere "Hastur"};-        return (not w);-      } { return false }-  - goal:-      - |-        Your robot obtained the misplaced artifact! Next you need to put it back-        on the pedestal.  But neither you nor your robot knows the-        artifact's name.  How can it be placed?-      - |-        Every command returns a value.  However, some simple commands, like-        `move`, do not have any meaningful-        value to return.  Swarm has a special type, `Unit`{=type}, with only one value,-        called `()`. Since there is only one possible value of type-        `Unit`{=type}, returning it does not convey any information.-        Thus, the type of `move` is `Cmd Unit`{=type}.+        Build a robot to retrieve and restore the mystery artifact to its proper place+        in the center of the pedestal!       - |-        Other commands do return a nontrivial value after executing.-        For example, `grab` has type `Cmd Text`{=type}, and returns the name of the-        grabbed entity as a text value.+        The robot will need to `place "ARTIFACT NAME"`{=snippet}, but you do not know the name yet!+        Fortunatelly, the `grab` command has type `Cmd Text`{=type}, and returns+        the name of the grabbed entity as a text value.       - |         To use the result of a command later, you need _bind notation_, which         consists of a variable name and a leftwards-pointing arrow-        before the command.  For example:-      - |-        ```-        move; t <- grab; place t-        ```+        before the command. Like this:       - |-        In the above example, the result returned by `grab` is assigned-        to the variable name `t`{=snippet}, which can then be used later.-        This is useful, for example, if you do not care what you-        grabbed and just want to move it to another cell, or if you-        are not sure of the name of the thing being grabbed.+        `move; art <- grab; place art`       - |-        Reminder: if you need to start over, your previous commands are-        accessible in the REPL history (up-arrow).+        **NOTE:** If you find yourself stuck, you can select "Start over" from+        the "Quit" (**Ctrl+Q**) dialog.+    prerequisite:+      not: fail_to_grab     condition: |       try {-        p <- robotnamed "pedestal";-        w <- as p {ishere "Hastur"};-        return w;-      } { return false }-    prerequisite: grab_artifact+        teleport self (0,3);+        ishere "Hastur"+      } { pure false }+  - id: fail_to_grab+    teaser: Robot stopped+    hidden: true+    optional: true+    goal:+      - |+        You sent a robot, but it failed to put the artifact in its rightful place.+      - |+        Try again by selecting "Start over" from the "Quit" (**Ctrl+Q**) dialog.+    condition: |+      as base {+        try {+          r <- robotnumbered 1;+          reprogram r {};+          teleport self (0,3);+          h <- ishere "Hastur";+          pure (not h)+        } {+          pure false+        }+      } solution: |   build {     move; move;-    turn right;-    move; move; move; move; move; move;-    x <- grab;-    turn left;-    move;-    turn left;-    move; move;-    place x;+    turn right; move; move;+    f <- grab;+    turn back; move; move;+    turn right; move;+    place f   } entities:   - name: Hastur@@ -81,6 +71,14 @@     description:       - The Unspeakable One     properties: [pickable]+  - name: pedestal+    display:+      attr: gold+      char: '+'+    description:+      - A stone pedestal.+    properties:+      - boundary robots:   - name: base     dir: north@@ -95,30 +93,21 @@       - [1, treads]       - [1, grabber]       - [1, compass]-  - name: floorspot-    system: true-  - name: pedestal-    system: true world:   palette:+    'Ω': [stone, null, base]     '.': [blank, null]-    'Ω': [blank, null, base]-    'x': [dirt, null]-    'H': [blank, Hastur, floorspot]-    's': [stone, null, pedestal]-    '┌': [stone, upper left corner]-    '┐': [stone, upper right corner]-    '└': [stone, lower left corner]-    '┘': [stone, lower right corner]-    '─': [stone, horizontal wall]-    '│': [stone, vertical wall]-  upperleft: [-1, -3]+    'x': [stone, pedestal]+    's': [stone, null]+    'H': [blank, Hastur]+    '+': [stone, wall]+  upperleft: [-5, 6]   map: |-    ┌─────────┐-    │.........│-    │...xxx...│-    │...xsx...│-    │...xxxH..│-    │.........│-    │Ω┌───────┘-    └─┘........+    ++++++++++++    +.........++    +...xxx...++    +...xsx...++    +...xxxH..++    +.........++    +++++Ω++++++    ....+++....
data/scenarios/Tutorials/build.yaml view
@@ -25,8 +25,8 @@         b <- ishere "flower";         move;         c <- ishere "flower";-        return (a || b || c);-      } { return false }+        pure (a || b || c);+      } { pure false } solution: |   build {turn right; move; move; harvest; turn right; move; place "flower"} robots:@@ -52,16 +52,11 @@     '.': [grass]     '~': [ice, water]     '*': [grass, flower]-    '┌': [stone, upper left corner]-    '┐': [stone, upper right corner]-    '└': [stone, lower left corner]-    '┘': [stone, lower right corner]-    '─': [stone, horizontal wall]-    '│': [stone, vertical wall]+    '+': [stone, wall]   upperleft: [-1, 1]   map: |-    ┌───┐-    │Ω.*│-    │...│-    │~~~│-    └───┘+    ++++++    +Ω.*++    +...++    +~~~++    +++++
data/scenarios/Tutorials/conditionals.yaml view
@@ -51,19 +51,19 @@         **TIP:** the two branches of an `if` must have the same type. In particular,         `if ... {grab} {}`{=snippet} is not         allowed, because `{grab}` has type `{Cmd Text}`{=type} whereas `{}`{=snippet} has type `{Cmd Unit}`{=type}.-        In this case `{grab; return ()}` has the right type.+        In this case `{grab; pure ()}` has the right type.     condition: |       try {         n <- as base {count "very small rock"};-        return (n == 4)-      } { return false}+        pure (n == 4)+      } { pure false} solution: |   def tL = turn left end;   def tB = turn back end;   def x4 = \c. c;c;c;c end;   def VSR = "very small rock" end;   def ifC = \c.\t.\e. b <- c; if b t e end;-  def pick = move; ifC (ishere VSR) {grab; return ()} {} end;+  def pick = move; ifC (ishere VSR) {grab; pure ()} {} end;   def pickrow = x4 pick; turn back; x4 move end;   build {     turn south; x4 (move; tL; pickrow; tL); tB; x4 move; x4 (give base VSR)@@ -103,18 +103,13 @@     '.': [grass]     '_': [stone]     'o': [stone, very small rock]-    '┌': [stone, upper left corner]-    '┐': [stone, upper right corner]-    '└': [stone, lower left corner]-    '┘': [stone, lower right corner]-    '─': [stone, horizontal wall]-    '│': [stone, vertical wall]+    '+': [stone, wall]   upperleft: [-1, 1]   map: |-    ┌─────┐-    │Ω....│-    │.o___│-    │._o__│-    │.___o│-    │.__o_│-    └─────┘+    ++++++++    +Ω....++    +.o___++    +._o__++    +.___o++    +.__o_++    +++++++
data/scenarios/Tutorials/craft.yaml view
@@ -19,7 +19,7 @@     condition: |       try {         as base {has "branch predictor"}-      } { return false }+      } { pure false } solution: |   make "branch"; make "branch predictor" robots:@@ -36,14 +36,9 @@ world:   palette:     'Ω': [grass, null, base]-    '┌': [stone, upper left corner]-    '┐': [stone, upper right corner]-    '└': [stone, lower left corner]-    '┘': [stone, lower right corner]-    '─': [stone, horizontal wall]-    '│': [stone, vertical wall]+    '+': [stone, wall]   upperleft: [-1, 1]   map: |-    ┌─┐-    │Ω│-    └─┘+    ++++    +Ω++    +++
− data/scenarios/Tutorials/crash-secret.sw 
@@ -1,72 +0,0 @@-// A for cycle from start to end (excluded) that carries a state.-def foreachF = \s.\e.\com.\state.-  if (s >= e) {-    return state-  } {-    n <- com state s;-    foreachF (s+1) e com n-  }-end;--// An infinite while cycle that carries a state.-def iterate = \state.\com.-  n <- com state;-  iterate n com;-end;--// At the beginning all robots can be given Win.-def allOK: Actor -> Bool = \rob.-  true-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. \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-    } {-      robLoc <- as rob {whereami};-      if (robLoc != myLoc) {-        log $ "the robot" ++ format rob ++ "is not in my cell";-        return f;-      } {-        try {-          reprogram rob { log msg; };-          log $ "successfully reprogrammed robot " ++ format rob;-          give rob "Win";-          log $ "successfully gave Win to robot " ++ format rob;-          return (\r. (rob != r && f rob));-        } {-          log $ "the robot " ++ format rob ++ "is missing a logger!";-          return f;-        };-      }-    }-end;--// --------------------------------------------------------------------------// RUN-// ---------------------------------------------------------------------------log "Hi, I am secret";-iterate allOK (tryGive-  $ "Send a robot to `salvage` me and come back to\n"-  ++ "`give base \"Win\".  When the rescue robot stands\n"-  ++ "where I am and executes `salvage`, all my inventory\n"-  ++ "and logs will go to it, including the \"Win\". Once you\n"-  ++ "have brought the \"Win\" to your base, you will win!\n\n"-  ++ "NOTE: if you are still viewing me when I am salvaged,\n"-  ++ "you will be in for a surprise!  If this happens just\n"-  ++ "type `view base` to return to viewing your base."-)
− data/scenarios/Tutorials/crash.yaml 
@@ -1,101 +0,0 @@-version: 1-name: Debug-description: |-  Learn how to view built robots and debug them.-objectives:-  - goal:-      - Before you send your robots far away from the `base` you need to learn how to figure out what went wrong with them if they crash.-      - |-        In this challenge, you should start by-        sending a robot to walk four steps straight east into the mountain,-        crashing deliberately.  However, you must make sure it has a `logger`{=entity},-        so we can see what command failed.  The simplest way to ensure-        that is to have it execute the `log` command; `build` will-        ensure it has the devices it needs to execute its commands.-        For example:-      - |-        ```-        build {log "Hi!"; turn east; move; move; move; log "3"; move; log "OK"}-        ```-      - |-        `wait` for the robot to crash, then execute `view it0`{=snippet} (or whichever-        `itN`{=snippet} variable corresponds to the result of the `build`-        command) to see how far it got. Further instructions should-        appear in the crashed robot's log and `give` you an opportunity to `salvage`-        the situation...-    condition: |-      try {-        as base {has "Win"}-      } { return false }-entities:-  - name: Win-    display:-      attr: device-      char: 'W'-    description:-      - If you have this, you win!-    properties: [known, pickable]-solution: |-  crasher <- build {-      turn east; move; move; move; log "bye"; move-  };-  wait 32;-  salvager <- build {-      log "I will bring home the Win!";-      turn east; move; move; move; salvage; turn back; move; move; give base "Win"-  };-robots:-  - name: base-    dir: north-    heavy: true-    display:-      char: Ω-      attr: robot-    devices:-      - logger-      - 3D printer-      - clock-    inventory:-      - [10, logger]-      - [10, compass]-      - [10, scanner]-      - [10, toolkit]-      - [10, solar panel]-      - [10, treads]-      - [10, grabber]-  - name: secret-    dir: [0, 0]-    devices:-      - logger-      - flash memory-      - dictionary-      - 3D printer-    inventory:-      - [100000, Win]-    display:-      invisible: true-    system: true-    program: |-      run "scenarios/Tutorials/crash-secret.sw"-known: [water, tree, mountain]-world:-  palette:-    'Ω': [grass, null, base]-    '!': [grass, null, secret]-    '.': [grass]-    '~': [ice, water]-    'T': [grass, tree]-    'A': [stone, mountain]-    '┌': [stone, upper left corner]-    '┐': [stone, upper right corner]-    '└': [stone, lower left corner]-    '┘': [stone, lower right corner]-    '─': [stone, horizontal wall]-    '│': [stone, vertical wall]-  upperleft: [-1, 3]-  map: |-    ┌─────┐-    │AAAT~│-    │..A.~│-    │Ω..!A│-    └─────┘
+ data/scenarios/Tutorials/debug-hint.sw view
@@ -0,0 +1,114 @@+def λcase = \f. \g. \s. case s f g end+def λmatch = \f. \p. match p f end++def elif = \p.\t.\f. {if p t f} end;++// A for cycle from start to end (excluded) that carries a state.+def foreachF = \s.\e.\com.\state.+  if (s >= e) {+    pure state+  } {+    n <- com state s;+    foreachF (s+1) e com n+  }+end;++// An infinite while cycle that carries a state.+def iterate = \state.\com.+  n <- com state;+  iterate n com;+end;++tydef RobotState = [gave_win: Bool, said_log_missing: Bool, said_loc: (Int * Int)] end;++// setters+def set_gave_win         : Bool -> RobotState -> RobotState = \v.\s. [gave_win=v,          said_log_missing=s.said_log_missing, said_loc=s.said_loc] end;+def set_said_log_missing : Bool -> RobotState -> RobotState = \v.\s. [gave_win=s.gave_win, said_log_missing=v,                  said_loc=s.said_loc] end;+def set_said_loc  : (Int * Int) -> RobotState -> RobotState = \v.\s. [gave_win=s.gave_win, said_log_missing=s.said_log_missing, said_loc=v         ]end;++tydef RobotsStateList = rec l. Unit + (Actor * RobotState * l) end;++def emptyList = inl () end;++// At the beginning all robots can be given Win.+def defaultState: RobotState =+  [gave_win=False, said_log_missing=False, said_loc=(-100,-100)]+end;++def query : Actor -> RobotsStateList -> RobotState = \rob.\l.+  case l (\_. defaultState) (λmatch \r. λmatch \s.\tail.+    if (r == rob) {s} {query rob tail}+  )+end;++def update : Actor -> RobotState -> RobotsStateList -> RobotsStateList = \rob.\s.\l.+  case l (\_. inr (rob, s, emptyList)) (λmatch \nr. λmatch \ns. \tail.+    if (nr == rob) {+      inr (rob, s, tail)+    } {+      inr (nr, ns, update rob s tail)+    }+  )+end;++myLoc <- whereami;++def foldM : (rec l. Unit + a * l) -> b -> (b -> a -> Cmd b) -> Cmd b =+  \xs. \b. \f. case xs+    (\_. pure b)+    (λmatch \h.\t. b2 <- f b h; foldM t b2 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 -> RobotsStateList -> Cmd RobotsStateList = \msg. \ok.+  instant (+    rs <- meetAll;+    foldM rs ok (\stateList.\rob.+      let state = query rob stateList in+      robLoc <- as rob {whereami};+      hasLog <- as rob {try {log "test"; pure true} {pure false}};+      if (state.gave_win) {+        // log $ "skipping the robot " ++ format rob ++ "because it already has a Win";+        pure stateList+      }+      $elif (robLoc != myLoc && state.said_loc != robLoc) {+        log $ "the robot " ++ format rob ++ " is not in my cell";+        pure (update rob (set_said_loc robLoc state) stateList);+      }+      $elif (not hasLog && state.said_log_missing)+      {+        say $ "the robot " ++ format rob ++ " is missing a logger!";+        pure (update rob (set_said_log_missing true state) stateList)+      }+      { // else +        try {+          reprogram rob { log msg; };+          log $ "successfully reprogrammed robot " ++ format rob;+          give rob "Win";+          log $ "successfully gave Win to robot " ++ format rob;+          pure (update rob (set_gave_win true state) stateList)+        } {+          log $ "the robot " ++ format rob ++ " is probably still active!";+          pure stateList+        };+      }+    )+  )+end;++// -------------------------------------------------------------------------+// RUN+// -------------------------------------------------------------------------++log "Hi, I am the system hint robot";+iterate emptyList (tryGive+  $ "Send a robot to `salvage` me and come back to"+  ++ " `give base \"Win\"`.  When the rescue robot stands"+  ++ " where I am and executes `salvage`, all my inventory"+  ++ " and logs will go to it, including the \"Win\". Once you"+  ++ " have brought the \"Win\" to your base, you will win!\n\n"+  ++ "NOTE: if you are still viewing me when I am salvaged,"+  ++ " you will be in for a surprise!  If this happens just"+  ++ " type `view base` to return to viewing your base."+)
+ data/scenarios/Tutorials/debug.yaml view
@@ -0,0 +1,103 @@+version: 1+name: Debug+description: |+  Learn how to view built robots and debug them.+objectives:+  - goal:+      - |+        Before you send your robots far away from the `base` you need to learn how+        to figure out what went wrong with them if they crash.+      - |+        In this challenge, you should start by sending a robot to walk four steps+        straight east into the closest mountain, crashing deliberately.+      - |+        However, you must make sure it has a `logger`{=entity},+        so we can see the failure in its logs. The simplest way to ensure+        that is to have it execute the `log` command; `build` will+        ensure it has the devices it needs to execute its commands.+        For example:+      - |+        ```+        build { turn east; move; move; move; log "brace for impact"; move; }+        ```+      - |+        `wait` for the robot to crash, then execute `view it0`{=snippet} (or whichever+        `itN`{=snippet} variable corresponds to the result of the `build`+        command) to see how far it got. Further instructions will+        appear in the crashed robot's log and `give` you an opportunity to `salvage`+        the situation...+    condition: |+      try {+        as base {has "Win"}+      } { pure false }+entities:+  - name: Win+    display:+      attr: device+      char: 'W'+    description:+      - Once the base has this, you win!+    properties: [known, pickable]+solution: |+  crasher <- build {+    turn east; move; move; move; log "brace for impact"; move+  };+  salvager <- build {+    log "I will bring home the Win!"; // This allows log messages to transfer over+    turn right; turn right; turn right; turn right;+    turn east; move; move; move; salvage; turn back; move; move; give base "Win"+  };+robots:+  - name: base+    dir: north+    heavy: true+    display:+      char: Ω+      attr: robot+    devices:+      - logger+      - 3D printer+      - clock+    inventory:+      - [10, logger]+      - [10, compass]+      - [10, scanner]+      - [10, toolkit]+      - [10, solar panel]+      - [10, treads]+      - [10, grabber]+  - name: hint+    dir: [0, 0]+    devices:+      - logger+      - hearing aid+      - flash memory+      - dictionary+      - 3D printer+    inventory:+      - [100000, Win]+    display:+      invisible: true+    system: true+    program: |+      run "scenarios/Tutorials/debug-hint.sw"+known: [water, wavy water, tree, mountain]+world:+  palette:+    'Ω': [grass, null, base]+    '!': [dirt, null, hint]+    '.': [grass]+    '_': [ice, water]+    '~': [ice, wavy water]+    'T': [grass, tree]+    'A': [stone, mountain]+    '+': [stone, wall]+  upperleft: [-1, 3]+  map: |+    ++++++++++    +...AAT_++    +.....A~++    +Ω..!AAA++    +.~_...A++    +~__~...++    +++++++++
data/scenarios/Tutorials/def.yaml view
@@ -32,7 +32,7 @@     condition: |       try {         as base {has "flower"}-      } { return false }+      } { pure false } solution: |   def m2 = move; move end;   def m4 = m2; m2 end;@@ -71,18 +71,13 @@     '.': [grass]     '*': [grass, flower]     '@': [grass, boulder]-    '┌': [stone, upper left corner]-    '┐': [stone, upper right corner]-    '└': [stone, lower left corner]-    '┘': [stone, lower right corner]-    '─': [stone, horizontal wall]-    '│': [stone, vertical wall]+    '+': [stone, wall]   upperleft: [-1, 5]   map: |-    ┌─────────────────┐-    │................*│-    │.@@@@@@@@@@@@@@@@│-    │.................│-    │@@@@@@@@@@@@@@@@.│-    │Ω................│-    └─────────────────┘+    ++++++++++++++++++++    +................*++    +.@@@@@@@@@@@@@@@@++    +.................++    +@@@@@@@@@@@@@@@@.++    +Ω................++    +++++++++++++++++++
data/scenarios/Tutorials/equip.yaml view
@@ -18,8 +18,8 @@     condition: |       try {         _ <- robotNumbered 1;-        return true;-      } { return false }+        pure true;+      } { pure false } solution: |   turn south; move; grab; equip "3D printer"; build {}; robots:@@ -41,16 +41,11 @@     '.': [grass]     '~': [ice, water]     '3': [grass, 3D printer]-    '┌': [stone, upper left corner]-    '┐': [stone, upper right corner]-    '└': [stone, lower left corner]-    '┘': [stone, lower right corner]-    '─': [stone, horizontal wall]-    '│': [stone, vertical wall]+    '+': [stone, wall]   upperleft: [-1, 1]   map: |-    ┌───┐-    │>..│-    │3..│-    │~~~│-    └───┘+    ++++++    +>..++    +3..++    +~~~++    +++++
data/scenarios/Tutorials/farming.sw view
@@ -27,7 +27,7 @@ end; def harvest_field : Text -> Cmd Unit = \thing.   x4 (-    x12 (move; ifC (ishere thing) {harvest; return ()} {});+    x12 (move; ifC (ishere thing) {harvest; pure ()} {});     next_row   );   tL; m4; tR@@ -38,7 +38,7 @@   ) end; build {-  require 1 "lambda";+  stock 1 "lambda";   tB; move; tR; plant_field "lambda"; }; build {
data/scenarios/Tutorials/farming.yaml view
@@ -34,9 +34,9 @@       try {         as base {           n <- count "lambda";-          return (n >= 256)+          pure (n >= 256)         }-      } { return false }+      } { pure false }   - goal:       - Congratulations!  You have completed the most difficult simulated exercise and are ready to begin exploring the new planet in earnest.  Of course there is much more remaining to explore in the world, and many additional programming language features to unlock.       - |@@ -45,7 +45,7 @@       - Afterwards, you will return to the menu where you can select "Classic game" for the complete game experience.  Or, play a "Creative game" if you just want to play around with programming robots, without any constraints or need to collect resources.  You could also choose to redo some tutorial scenarios, or explore the other challenge scenarios listed in the menu.       - Now go forth and build your swarm!     condition: |-      try {as base {has "curry"}} {return false}+      try {as base {has "curry"}} {pure false}     prerequisite: get_many_lambdas solution: |   run "scenarios/Tutorials/farming.sw";@@ -81,9 +81,8 @@       - [10, tree]       - [10, harvester]       - [10, logger]-seed: 0+seed: 2 world:-  offset: true   scrollable: false   dsl: |     "classic"
data/scenarios/Tutorials/give.yaml view
@@ -3,32 +3,59 @@ description: |   Learn how to give items to other robots. objectives:-  - goal:+  - id: give_bit+    teaser: Give base bit+    goal:       - |         Robots can transfer items between them using the `give`         command. This command takes two arguments: the target         robot, and the name of the item to give.  The target robot         is often the special `base` robot, but could be any robot.-      - In this scenario, you will need to collect the items scattered around your `base`, by `build`ing one or more robots to collect them and then `give` them to you.+      - |+        In this scenario, you will need to collect the items scattered+        around your `base`, by `build`ing one or more robots to collect+        them and then `give` them to you.+      - |+        This is a training simulation, so the items will reappear after a while.+      - |+        Start with `build`ing a robot to `grab` the `bit (0)`{=entity} east of the base, then return to `give` it to the `base`.     condition: |+      as base { has "bit (0)" }+  - id: give_rest+    teaser: Fetch the rest+    goal:+      - |+        Good job. Now send robots to grab the rest!+      - |+        Where will you find the item names, so you can `give base "item name"`?+        That's the neat part, you won't!+      - |+        You will get the name from the `grab` command result, for example:+        ```+        build { move; w <- grab; log w; turn back; move; give base w }+        ```+      - |+        **TIP:** Instead of trial and error, you can get the distance to items+        by clicking on them in the world map, which will show the coordinates.+    prerequisite: give_bit+    condition: |       as base {-          bd <- has "board";-          b0 <- has "bit (0)";-          lx <- has "LaTeX";-          co <- has "copper ore";-          return $ bd && b0 && lx && co;+          b <- has "board";+          l <- has "LaTeX";+          c <- has "copper ore";+          pure $ b && l && c;       }; solution: |   build {-    turn back; move; turn right; move; move; move; grab;-    turn right; move; move; turn right; move; grab;-    move; move; move; move; turn right; move; grab;-    turn left; move; move; turn right; move; move; grab;+    turn back; move; turn right; move; move; move; latex <- grab;+    turn right; move; move; turn right; move; board <- grab;+    move; move; move; move; turn right; move; copper <- grab;+    turn left; move; move; turn right; move; move; bit <- grab;     turn right; move; move; move; move; turn right; move; move;-    give base "LaTeX";-    give base "board";-    give base "copper ore";-    give base "bit (0)";+    give base latex;+    give base board;+    give base copper;+    give base bit;   } robots:   - name: base@@ -47,27 +74,32 @@       - [10, scanner]       - [10, treads]       - [10, solar panel]+  - name: replacer+    system: true+    program: |+      def replace: Cmd Unit =+          i <- scan down;+          watch down; wait 2024; wait 32;+          case i (\_. noop) (\i. create i; try { place i } {} );+          replace;+      end;+      replace known: [board, LaTeX, bit (0), copper ore] world:   palette:     'Ω': [grass, null, base]     '.': [grass]-    'w': [grass, board]-    '$': [grass, LaTeX]-    '0': [grass, bit (0)]-    'C': [grass, copper ore]-    '┌': [stone, upper left corner]-    '┐': [stone, upper right corner]-    '└': [stone, lower left corner]-    '┘': [stone, lower right corner]-    '─': [stone, horizontal wall]-    '│': [stone, vertical wall]-  upperleft: [-1, 3]+    'w': [dirt, board, replacer]+    '$': [grass, LaTeX, replacer]+    '0': [grass, bit (0), replacer]+    'C': [grass, copper ore, replacer]+    '+': [stone, wall]+  upperleft: [-5, 3]   map: |-    ┌─────────┐-    │.........│-    │..w......│-    │....Ω.0..│-    │.$.......│-    │........C│-    └─────────┘+    ++++++++++++    +.........++    +..w......++    +....Ω.0..++    +.$.......++    +........C++    +++++++++++
data/scenarios/Tutorials/grab.yaml view
@@ -10,8 +10,8 @@     condition: |       try {         t <- as base {count "tree"};-        return (t >= 6);-      } { return false }+        pure (t >= 6);+      } { pure false } solution: |   move;   move; grab;@@ -35,14 +35,9 @@     '>': [grass, null, base]     '.': [grass]     'T': [grass, tree]-    '┌': [stone, upper left corner]-    '┐': [stone, upper right corner]-    '└': [stone, lower left corner]-    '┘': [stone, lower right corner]-    '─': [stone, horizontal wall]-    '│': [stone, vertical wall]+    '+': [stone, wall]   upperleft: [-1, 1]   map: |-    ┌────────┐-    │>.TTTTTT│-    └────────┘+    +++++++++++    +>.TTTTTT++    ++++++++++
data/scenarios/Tutorials/lambda.yaml view
@@ -23,8 +23,8 @@       try {         teleport self (32,-16);         b <- ishere "flower";-        return (not b)-      } { return false }+        pure (not b)+      } { pure false } solution: |   def x4 = \c. c; c; c; c end;   def m2 = move; move end;@@ -60,32 +60,27 @@   palette:     'Ω': [grass, null, base]     '.': [grass]+    '_': [dirt]     '*': [grass, flower]-    '@': [grass, boulder]-    '┌': [stone, upper left corner]-    '┐': [stone, upper right corner]-    '└': [stone, lower left corner]-    '┘': [stone, lower right corner]-    '─': [stone, horizontal wall]-    '│': [stone, vertical wall]+    '#': [stone, wall]   upperleft: [-1, 1]   map: |-    ┌─────────────────────────────────┐-    │.......@.......@.......@.......@@│-    │.@@@@@.@.@@@@@.@.@@@@@.@.@@@@@.@@│-    │.....@.@.....@.@.....@.@.....@.@@│-    │@@@@.@.@@@@@.@.@@@@@.@.@@@@@.@.@@│-    │.....@.@.....@.@.....@.@.....@.@@│-    │.@@@@@.@.@@@@@.@.@@@@@.@.@@@@@.@@│-    │.....@.@.....@.@.....@.@.....@.@@│-    │@@@@.@.@@@@@.@.@@@@@.@.@@@@@.@.@@│-    │.....@.@.....@.@.....@.@.....@.@@│-    │.@@@@@.@.@@@@@.@.@@@@@.@.@@@@@.@@│-    │.....@.@.....@.@.....@.@.....@.@@│-    │@@@@.@.@@@@@.@.@@@@@.@.@@@@@.@.@@│-    │.....@.@.....@.@.....@.@.....@.@@│-    │.@@@@@.@.@@@@@.@.@@@@@.@.@@@@@.@@│-    │.....@.@.....@.@.....@.@.....@.@@│-    │@@@@.@.@@@@@.@.@@@@@.@.@@@@@.@.@@│-    │Ω....@.......@.......@.......@..*│-    └─────────────────────────────────┘+    ###################################+    #_......#.......#_......#.......#_#+    #_#####.#.#####.#_#####.#.#####.#_#+    #_____#.#.....#.#_____#.#.....#.#_#+    #####_#.#####.#.#####_#.#####.#.#_#+    #.____#.#_....#.#.____#.#_....#.#_#+    #.#####.#_#####.#.#####.#_#####.#_#+    #.....#.#_____#.#.....#.#_____#.#_#+    #####.#.#####_#.#####.#.#####_#.#_#+    #_....#.#.____#.#_....#.#.____#.#_#+    #_#####.#.#####.#_#####.#.#####.#_#+    #_____#.#.....#.#_____#.#.....#.#_#+    #####_#.#####.#.#####_#.#####.#.#_#+    #.____#.#_....#.#.____#.#_....#.#_#+    #.#####.#_#####.#.#####.#_#####.#_#+    #.....#.#_____#.#.....#.#_____#.#_#+    #####.#.#####_#.#####.#.#####_#.###+    #Ω....#...____#.......#...____#..*#+    ###################################
data/scenarios/Tutorials/make_curry.sw view
@@ -3,8 +3,9 @@ make "log"; make "log"; make "board"; make "board"; make "boat"; build {   require "boat";-  turn right; move; move; move; grab; turn back; move; move; move;+  move; move; move; turn right; move; move; move; grab;+  turn back; move; move; move; turn left; move; move; move;   give base "water"; };-wait 16;+wait 24; make "curry"
data/scenarios/Tutorials/move.yaml view
@@ -6,46 +6,64 @@   - id: move_to_first_flower     teaser: Get the flower     goal:-      - Robots can use the `move` command to move forward one unit in the direction they are currently facing.-      - To complete this challenge, move your robot two spaces to the right, to the coordinates `(2,0)` marked with the purple `flower`{=entity}.-      - Note that you can chain commands with semicolon, `;`{=snippet}.-      - You can open this popup window at any time to remind yourself of the goal using **Ctrl+G**.+      - |+        Robots can use the `move` command to move forward one unit in the direction they are currently facing.++        To complete this challenge, move your robot two spaces to the right, to the coordinates `(2,0)`+        marked with the purple `flower`{=entity}.++        Note that you can chain commands with semicolon, `;`{=snippet}.++        You can open this popup window at any time to remind yourself of the goal using **Ctrl+G**.     condition: |-      r <- robotNamed "check1";-      loc <- as r {has "Win"};+      as base {l <- whereami; pure (l == (2,0))}   - id: move_along_corridor     teaser: Down the corridor     goal:-      - Good! Now you need to learn how to effectively repeat actions.       - |+        Good! Now you need to learn how to effectively repeat actions.+         Previously you could move twice by chaining the move command:-      - |-        ```-        move; move-        ```-      - To reuse that command without having to retype it press the upward arrow on your keyboard. This will allow you to select previous commands.-      - Ahead of you is a six steps long corridor. Move to its end, i.e. the coordinates `(8,0)` marked with the second purple `flower`{=entity}.-      - You can open this popup window at any time to remind yourself of the goal using **Ctrl+G**.++        `move; move`++        To reuse that command without having to retype it, press the up arrow on your keyboard.+        This will allow you to select previously entered commands.++        Ahead of you is a six steps long corridor. Move to its end, i.e. the coordinates `(8,0)` marked+        with the second purple `flower`{=entity}.++        Note that you do not need to type everything in one go; you+        can enter multiple commands, as long as they eventually get+        you to the flower.++        You can open this popup window at any time to remind yourself of the goal using **Ctrl+G**.     condition: |-      r <- robotNamed "check2";-      loc <- as r {has "Win"};+      as base {l <- whereami; pure (l == (8,0))}     prerequisite: move_to_first_flower   - id: move_northeast_corner     teaser: To northeast corner     goal:-      - Well done! In addition to `move`, you can use the `turn` command to turn your robot, for example, `turn right` or `turn east`.-      - Switch to the inventory view in the upper left (by clicking on it or typing **Alt+E**) and select the `treads`{=entity} device to read about the details. If the bottom-left info panel is not big enough to read the whole thing, you can hit **Enter** on the `treads`{=entity} device to pop out the description, or you can focus the info panel (with **Alt+T** or by clicking) and scroll it with arrow keys or **PgUp**/**PgDown**. When you're done reading, you can come back to the REPL prompt by clicking on it or typing **Alt+R**.-      - Afterwards, move your robot to the coordinates `(8,4)` in the northeast corner marked with two flowers.       - |+        Well done! In addition to `move`, you can use the `turn` command to turn your robot, for example,+        `turn right` or (if you have a `compass`{=entity}) `turn east`.++        Switch to the inventory view in the upper left (by clicking on it or typing **Alt+E**) and select+        the `treads`{=entity} device to read about the details.+        If the bottom-left info panel is not big enough to read the whole thing, you can hit **Enter**+        on the `treads`{=entity} device to pop out the description, or you can focus the info panel+        (with **Alt+T** or by clicking) and scroll it with arrow keys or **PgUp**/**PgDown**.+        When you're done reading, you can come back to the REPL prompt by clicking on it or typing **Alt+R**.++        Afterwards, move your robot to the coordinates `(8,4)` in the northeast corner marked with another flower.+         Remember, you can chain commands with `;`{=snippet}, for example:-      - |-        ```-        move;move;move;move-        ```-      - You can open this popup window at any time to remind yourself of the goal using **Ctrl+G**.++        `move; move; move; move`++        You can open this popup window at any time to remind yourself of the goal using **Ctrl+G**.     condition: |-      r <- robotNamed "check3";-      loc <- as r {has "Win"};+      as base {l <- whereami; pure (l == (8,4))}     prerequisite: move_along_corridor   - goal:       - Good job! You are now ready to move and turn on your own.@@ -53,8 +71,7 @@       - Remember you can press the upward arrow on your keyboard to select previous commands.       - You can open this popup window at any time to remind yourself of the goal using **Ctrl+G**.     condition: |-      r <- robotNamed "check4";-      loc <- as r {has "Win"};+      as base {l <- whereami; pure (l == (8,8))}     prerequisite: move_northeast_corner solution: |   // 0@@ -79,52 +96,31 @@ world:   palette:     '.': [blank]-    '*': [blank, flower]-    'X': [blank, null, 1P flower]-    'Y': [blank, null, 2P flower]-    'Z': [blank, null, 3P flower]     # FIRST ROOM-    '┌': [blank, upper left corner]-    '┐': [blank, upper right corner, 1S down and horizontal wall]-    '└': [blank, lower left corner]-    '┘': [blank, lower right corner, 1S up and horizontal wall]-    '─': [blank, horizontal wall]-    '│': [blank, vertical wall]+    '0': [blank, wall]+    'A': [blank, flower, check]     # SECOND ROOM-    '1': [blank, vertical wall, 1G]-    '-': [blank, null, 1P horizontal wall]-    '|': [blank, null, 1P vertical wall]-    'c': [blank, null, 1P upper right corner, 2S left and vertical wall]-    'b': [blank, null, 1P lower right corner]-    'd': [blank, null, 1P horizontal wall, 2S up and horizontal wall]+    '1': [blank, null, 1P wall]+    'B': [blank, null, 1P flower]     # THIRD ROOM-    '2': [blank, null, 1P horizontal wall, 2G]-    '~': [blank, null, 2P horizontal wall]-    '/': [blank, null, 2P vertical wall]-    'R': [blank, null, 2P upper right corner]-    'L': [blank, null, 2P upper left corner, 3S down and horizontal wall]-    'K': [blank, null, 2P vertical wall, 3S left and vertical wall]+    '2': [blank, null, 2P wall]+    'C': [blank, null, 2P flower]     # FOURTH ROOM-    '3': [blank, null, 2P vertical wall, 3G]-    '_': [blank, null, 3P horizontal wall]-    '\': [blank, null, 3P vertical wall]-    'A': [blank, null, 3P lower left corner]-    'B': [blank, null, 3P lower right corner]-    'C': [blank, null, 3P upper right corner]-    'D': [blank, null, 3P upper left corner]+    '3': [blank, null, 3P wall]+    'D': [blank, null, 3P flower]   upperleft: [-1, 9]   map: |-    D_________C-    \........Z\-    \..D______B-    \..\.......-    \..A___L~~R-    \......3YY/-    A______K../-    ......./../-    ┌───┐--d22c-    │..*1....X|-    └───┘-----b+    33333333333+    3........D3+    3..33333333+    3..3.......+    3..33332222+    3......2.C2+    33333332..2+    .......2..2+    00000111111+    0..A0....B1+    00000111111 # Font inspiration and a nicely visible separator: # # ███████ ██     ██  █████  ██████  ███    ███@@ -132,6 +128,7 @@ # ███████ ██  █  ██ ███████ ██████  ██ ████ ██ #      ██ ██ ███ ██ ██   ██ ██   ██ ██  ██  ██ # ███████  ███ ███  ██   ██ ██   ██ ██      ██+stepsPerTick: 300 robots:   - name: base     dir: east@@ -143,196 +140,69 @@   #################   ## OBJECTIVES  ##   #################-  - name: check1-    loc: [2, 0]-    system: true-    program: |-      def until = \c. b <- c; if b {} {until c} end;-      l <- whereami;-      until (-        try {-          loc <- as base {whereami};-          return (loc == l)-        } { return false }-      );-      create "Win"-  - name: check2-    loc: [8, 0]-    system: true-    program: |-      def until = \c. b <- c; if b {} {until c} end;-      l <- whereami;-      until (-        try {-          loc <- as base {whereami};-          return (loc == l)-        } { return false }-      );-      create "Win"-  - name: check3-    loc: [8, 4]-    system: true-    program: |-      def until = \c. b <- c; if b {} {until c} end;-      l <- whereami;-      until (-        try {-          loc <- as base {whereami};-          return (loc == l || loc == (fst l - 1, snd l))-        } { return false }-      );-      create "Win"-  - name: check4-    loc: [8, 8]-    system: true-    program: |-      def until = \c. b <- c; if b {} {until c} end;-      l <- whereami;-      until (-        try {-          loc <- as base {whereami};-          return (loc == l)-        } { return false }-      );-      create "Win"-  #################-  ## HORIZONTAL  ##-  #################-  - name: 1P horizontal wall-    system: true-    program: run "scenarios/Tutorials/move_system.sw"-  - name: 2P horizontal wall-    system: true-    program: run "scenarios/Tutorials/move_system.sw"-  - name: 3P horizontal wall-    system: true-    program: run "scenarios/Tutorials/move_system.sw"-  #################-  ## VERTICAL    ##-  #################-  - name: 1P vertical wall-    system: true-    program: run "scenarios/Tutorials/move_system.sw"-  - name: 2P vertical wall-    system: true-    program: run "scenarios/Tutorials/move_system.sw"-  - name: 3P vertical wall-    system: true-    program: run "scenarios/Tutorials/move_system.sw"-  #################-  ## CORNERS     ##-  #################-  # the order is:-  # upleft   upright-  #     D+----+C-  #      |    |-  #      |    |-  #     A+----+B-  # lowleft  lowright-  #########-  ##  A  ##-  #########-  - name: 1P lower left corner-    system: true-    program: run "scenarios/Tutorials/move_system.sw"-  - name: 2P lower left corner-    system: true-    program: run "scenarios/Tutorials/move_system.sw"-  - name: 3P lower left corner-    system: true-    program: run "scenarios/Tutorials/move_system.sw"-  #########-  ##  B  ##-  #########-  - name: 1P lower right corner-    system: true-    program: run "scenarios/Tutorials/move_system.sw"-  - name: 2P lower right corner-    system: true-    program: run "scenarios/Tutorials/move_system.sw"-  - name: 3P lower right corner-    system: true-    program: run "scenarios/Tutorials/move_system.sw"-  #########-  ##  C  ##-  #########-  - name: 1P upper right corner-    system: true-    program: run "scenarios/Tutorials/move_system.sw"-  - name: 2P upper right corner-    system: true-    program: run "scenarios/Tutorials/move_system.sw"-  - name: 3P upper right corner-    system: true-    program: run "scenarios/Tutorials/move_system.sw"-  #########-  ##  D  ##-  #########-  - name: 1P upper left corner-    system: true-    program: run "scenarios/Tutorials/move_system.sw"-  - name: 2P upper left corner-    system: true-    program: run "scenarios/Tutorials/move_system.sw"-  - name: 3P upper left corner-    system: true-    program: run "scenarios/Tutorials/move_system.sw"-  #################-  ## SEPARATORS  ##-  #################-  # 1-  - name: 1S down and horizontal wall-    system: true-    program: run "scenarios/Tutorials/move_system.sw"-  - name: 1S up and horizontal wall-    system: true-    program: run "scenarios/Tutorials/move_system.sw"-  # 2-  - name: 2S left and vertical wall-    system: true-    program: run "scenarios/Tutorials/move_system.sw"-  - name: 2S up and horizontal wall-    system: true-    program: run "scenarios/Tutorials/move_system.sw"-  # 3-  - name: 3S left and vertical wall-    system: true-    program: run "scenarios/Tutorials/move_system.sw"-  - name: 3S down and horizontal wall+  - name: check     system: true-    program: run "scenarios/Tutorials/move_system.sw"+    program: instant (run "scenarios/Tutorials/move_check.sw")   #################-  ## GATES       ##+  ## WALLS       ##   #################-  - name: 1G+  - name: 1P wall     system: true     program: |-      def until = \c. b <- c; if b {} {until c} end;-      c1 <- robotNamed "check1";-      until (as c1 {has "Win"});-      grab-  - name: 2G+      def main = \a. pure noop end+      instant (+        run "scenarios/Tutorials/move_surveil.sw";+        main [entity="wall", room=1]+      )+  - name: 2P wall     system: true-    program: run "scenarios/Tutorials/move_system.sw"-  - name: 3G+    program: |+      def main = \a. noop end+      instant (+        run "scenarios/Tutorials/move_surveil.sw";+        main [entity="wall", room=2]+      )+  - name: 3P wall     system: true-    program: run "scenarios/Tutorials/move_system.sw"+    program: |+      def main = \a. noop end+      instant (+        run "scenarios/Tutorials/move_surveil.sw";+        main [entity="wall", room=3]+      )   #################   ## GARDENERS   ##   #################   - name: 1P flower     system: true-    program: run "scenarios/Tutorials/move_system.sw"+    program: |+      def main = \a. noop end+      instant (+        run "scenarios/Tutorials/move_surveil.sw";+        main [entity="flower", room=1]+      )   - name: 2P flower     system: true-    program: run "scenarios/Tutorials/move_system.sw"+    program: |+      def main = \a. noop end+      instant (+        run "scenarios/Tutorials/move_surveil.sw";+        main [entity="flower", room=2]+      )   - name: 3P flower     system: true-    program: run "scenarios/Tutorials/move_system.sw"+    program: |+      def main = \a. noop end+      instant (+        run "scenarios/Tutorials/move_surveil.sw";+        main [entity="flower", room=3]+      ) entities:-  - name: Win+  - name: door     display:-      char: W-      attr: gold+      char: 'D'+      attr: entity+      invisible: true     description:-      - This entity signals that the objective has been met.+      - A wall+    properties: [boundary]
+ data/scenarios/Tutorials/move_check.sw view
@@ -0,0 +1,59 @@+def until = \cond. \c. b <- cond; if b {} {c; until cond c} end+def abs = \x. if (x >= 0) {x} {-x} end++def open_door = create "door"; swap "door" end++def λmatch = \f. \p. match p f end++// TRICK:+// we only check for base at this location+// so we can sleep for as long as base will take to get here+def get_dist = λmatch \l1. \l2. λmatch \bl1. \bl2.+  abs (l1 - bl1) + abs (l2 - bl2)+end++def waitForBaseAt = \l. \get_timeout.+    loc <- as base {whereami};+    if (loc == l) {+        pure true+    } {+        wait (get_timeout l loc);+        waitForBaseAt l get_timeout+    }+end++def room1 = +    // l <- whereami;+    let l = (2, 0) in+    waitForBaseAt l (\_. \_. 1);+    log "room 1 done";+    // open door+    turn east; move; open_door;+end++def room2 =+    let l = (8, 0) in+    teleport self l;+    waitForBaseAt l get_dist;+    log "room 2 done";+    // open doors+    turn north; move; open_door;+    turn west; move; open_door;+end++def room3 =+    let l = (8, 4) in+    teleport self l;+    waitForBaseAt l get_dist;+    log "room 3 done";+    // open door+    turn west; move; move; open_door;+end++def main =+   room1;+   room2;+   room3;+end++main
+ data/scenarios/Tutorials/move_surveil.sw view
@@ -0,0 +1,45 @@+def elif = \b.\t.\e. {if b t e} end+def else = \e. e end++def position: Int -> (Int * Int) = \room.+    if (room == 1) {+        (3,0)+    } $elif (room == 2) {+        (7,1)+    } $elif (room == 3) {+        (6,4)+    } $else {+        fail $ "unknown room: " ++ format room+    }+end++def wait_until_change = \pos. \original. \cont.+    surveil pos;+    timeout <- random 10000;+    wait timeout;+    current <- as self {teleport self pos; scan down};+    if (current != original) {+        cont current;+    } {+        log $ "no change after " ++ format timeout ++ " ticks - continue";+        wait_until_change pos original cont+    }+end++def main: [entity: Text, room: Int] -> Cmd Unit = \args.+    let pos = position args.room in+    log $ format args;+    original <- as self {teleport self pos; scan down};+    log $ "surveil position" ++ format pos ++ ": " ++ format original;+    create args.entity;+    log $ "sleeping until " ++ format pos ++ " changes";+    wait_until_change pos original ( \changed.+        if (args.room == 1) {+            place args.entity+        } {+            // for later rooms a wall appears and then a door is opened+            log $ "sleeping until " ++ format pos ++ " changes again";+            wait_until_change pos changed (\_. place args.entity)+        }+    )+end
− data/scenarios/Tutorials/move_system.sw 
@@ -1,28 +0,0 @@-def until = \c. b <- c; if b {} {until c} end;--// name format: NA Entity-// N - one digit room number-// A one letter action-nameCheck <- atomic (-    name <- whoami;-    check <- robotNamed ("check" ++ fst (split 1 name));-    return (name, check)-);-let a = fst $ split 1 $ snd $ split 1 $ fst nameCheck in-let e = snd $ split 3 $ fst nameCheck in--until (as (snd nameCheck) {has "Win"});--if (a == "S") {-    if (e != "") { create e } {};-    swap e;-    return ()-} { if (a == "G") {-    grab;-    return ()-} { if (a == "P") {-    if (e != "") { create e } {};-    place e-} {-    say $ "Finished waiting for check but I don't know what to do: '" ++ a ++ "'"-}}}
data/scenarios/Tutorials/place.yaml view
@@ -30,8 +30,8 @@     condition: |       try {         t <- as base {count "spruce"};-        return (t >= 6);-      } { return false }+        pure (t >= 6);+      } { pure false } entities:   # faster tree (the normal one grows 500-600 ticks)   - name: spruce@@ -76,14 +76,9 @@     '>': [grass, null, base]     '.': [grass]     'T': [grass, spruce]-    '┌': [stone, upper left corner]-    '┐': [stone, upper right corner]-    '└': [stone, lower left corner]-    '┘': [stone, lower right corner]-    '─': [stone, horizontal wall]-    '│': [stone, vertical wall]+    '+': [stone, wall]   upperleft: [-1, 1]   map: |-    ┌────────┐-    │>.T.....│-    └────────┘+    +++++++++++    +>.T.....++    ++++++++++
data/scenarios/Tutorials/require.yaml view
@@ -4,14 +4,31 @@   Learn how to require additional devices that would otherwise not be equipped. objectives:   - goal:-      - The `build` command automatically equips devices on the newly built robot that it knows will be required.  For example, if you `build {move}`, some `treads`{=entity} will automatically be equipped on the new robot since it needs them to `move`.  (To see what the `build` command will equip, you can type `requirements <e>`{=snippet} where `<e>`{=snippet} is any expression.)-      - However, sometimes you need a device but `build` can't tell that you need it. In this case, you can use the special `require`{=snippet} command to require a particular device.  For example, if you `build {require "3D printer"; move}`, a `3D printer`{=entity} will be equipped on the new robot (in addition to `treads`{=entity}) even though it does not execute any commands that use one.-      - Your goal is to pick a flower on the other side of the river and bring it back to your base.  You win when the base has a `periwinkle`{=entity} flower in its inventory.-      - "Hint: robots will drown in the `water`{=entity} unless they have a `boat`{=entity} device equipped!"+      - |+        The `build` command automatically equips devices on the newly built robot that it knows will be required.+        For example, if you `build {move}`, some `treads`{=entity} will automatically be equipped on the new robot+        since it needs them to `move`.+      - |+        However, sometimes you need a device but `build` can't tell that you need it.+        In this case, you can use the special `require`{=snippet} command to require a particular device.+        For example, if you run:+        ```+        build {require "boat"; move}+        ```+        Then a `boat`{=entity} will be equipped on the new robot in addition to `treads`{=entity}.+      - |+        Unlike other devices used so far in the tutorial, `boat`{=entity} does not provide any commands,+        but robots that have it equipped will not drown in the `water`{=entity}.+      - |+        Your goal is to pick a flower on the other side of the river and bring it back to your base.+        You win when the base has a `periwinkle`{=entity} flower in its inventory.+      - |+        **TIP:** To see what the `build` command will equip, you can type `requirements <e>`{=snippet}+        where `<e>`{=snippet} is any expression.     condition: |       try {         as base {has "periwinkle"}-      } { return false }+      } { pure false } entities:   - name: periwinkle     display:@@ -20,11 +37,13 @@     description:       - A flower.     properties: [known, infinite, pickable]+# The player has just done the lambda tutorial, so this neat version is available: solution: |-  def m5 = move; move; move; move; move end;+  def x5 = \c. c;c;c;c;c end;   build {-    require "boat"; turn right;-    m5; f <- grab; turn back; m5; give base f+    require "boat";+    turn right; x5 move; f <- grab;+    turn back; x5 move; give base f   } robots:   - name: base@@ -45,25 +64,22 @@       - [10, grabber]       - [10, scanner]       - [10, compass]-known: [water]+      - [10, lambda]+known: [water, wavy water] world:   palette:     'Ω': [grass, null, base]     '.': [grass]-    '~': [ice, water]+    '_': [ice, water]+    '~': [ice, wavy water]     '*': [grass, periwinkle]-    '┌': [stone, upper left corner]-    '┐': [stone, upper right corner]-    '└': [stone, lower left corner]-    '┘': [stone, lower right corner]-    '─': [stone, horizontal wall]-    '│': [stone, vertical wall]+    '+': [stone, wall]   upperleft: [-1, 3]   map: |-    ┌──────┐-    │..~~..│-    │..~~..│-    │Ω.~~.*│-    │..~~..│-    │..~~..│-    └──────┘+    +++++++++    +..~_..++    +.._~..++    +Ω.__.*++    +..~_..++    +.._~..++    ++++++++
− data/scenarios/Tutorials/requireinv.yaml 
@@ -1,77 +0,0 @@-version: 1-name: Require inventory-description: |-  Learn how to require inventory when building robots.-objectives:-  - goal:-      - In the previous tutorial challenge, you learned how to use `require`{=snippet} to require specific devices to be equipped. Sometimes, instead of requiring equipped devices, you require supplies in your inventory.  In this case, you can write `require <int> <name>`{=snippet} to require a certain number of copies of a certain entity to be placed in your inventory.-      - For example, `build {require 10 "flower"; move; move}` would build a robot with 10 `flower`{=entity}s in its inventory.-      - Your goal in this challenge is to cover the entire 4x4 gray area with `rock`{=entity}s!-      - |-        Remember that you can define commands to simplify your task, for example:-        ```-        def PR = move; place "rock" end-        ```-    condition: |-      def repeat = \n. \c. if (n == 0) {} {c ; repeat (n-1) c} end;-      def ifC = \test. \then. \else. b <- test; if b then else end;-      try {-        teleport self (0,0); turn south;-        repeat 4 (-          move; turn east;-          repeat 4 (-            move;-            ifC (ishere "rock") {} {create "tree"};-          );-          turn back; move; move; move; move; turn left-        );-        ifC (has "tree") {return false} {return true}-      } { return false }-solution: |-  def x4 = \c. c;c;c;c end;-  def mp = move; place "rock" end;-  def rr = turn right; move; turn right; x4 mp; turn back; x4 move end;-  build {-    require 16 "rock";-    x4 rr-  };-robots:-  - name: base-    heavy: true-    dir: north-    display:-      char: Ω-      attr: robot-    devices:-      - logger-      - 3D printer-      - dictionary-    inventory:-      - [16, compass]-      - [16, solar panel]-      - [16, logger]-      - [16, treads]-      - [16, grabber]-      - [16, scanner]-      - [16, lambda]-      - [100, rock]-world:-  palette:-    'Ω': [grass, null, base]-    '.': [grass]-    '_': [stone]-    '┌': [stone, upper left corner]-    '┐': [stone, upper right corner]-    '└': [stone, lower left corner]-    '┘': [stone, lower right corner]-    '─': [stone, horizontal wall]-    '│': [stone, vertical wall]-  upperleft: [-1, 1]-  map: |-    ┌─────┐-    │Ω....│-    │.____│-    │.____│-    │.____│-    │.____│-    └─────┘
data/scenarios/Tutorials/scan.yaml view
@@ -4,16 +4,23 @@   Learn how to send robots to safely scan your surroundings. objectives:   - goal:-      - When you land on an alien planet, all the entities in the world will be unfamiliar to you, but you can learn what they are using the `scan` command, enabled by a `scanner`{=entity} device.-      - Send one or more robots to move next to some of the unknown entities (marked as "?"), scan them (with something like `scan forward` or `scan north`), and then return to the base and execute `upload base`.-      - For more information about the `scan` and `upload` commands, read the description of the `scanner`{=entity} in your inventory.+      - |+        When you land on an alien planet, all the entities in the world will be unfamiliar to you,+        but you can learn what they are using the `scan` command, enabled by a `scanner`{=entity} device.+      - |+        Send one or more robots to move next to some unknown entity (marked as "?"),+        scan it (with something like `scan forward` or `scan north`), and then return to the base+        and execute `upload base`.+      - |+        For more information about the `scan` and `upload` commands, read the description+        of the `scanner`{=entity} in your inventory. Hit Enter to open the description in a larger window.     condition: |       try {         bm <- as base {knows "mountain"};         bt <- as base {knows "tree"};         bw <- as base {knows "wavy water"};-        return (bm || bt || bw)-      } { return false }+        pure (bm || bt || bw)+      } { pure false } solution: |   build {     turn east; move; move; move;@@ -46,16 +53,11 @@     '~': [ice, wavy water]     'T': [grass, tree]     'A': [stone, mountain]-    '┌': [stone, upper left corner]-    '┐': [stone, upper right corner]-    '└': [stone, lower left corner]-    '┘': [stone, lower right corner]-    '─': [stone, horizontal wall]-    '│': [stone, vertical wall]+    '+': [stone, wall]   upperleft: [-1, 3]   map: |-    ┌─────┐-    │AAAT~│-    │..A.~│-    │Ω...A│-    └─────┘+    ++++++++    +AAAT~++    +..A.~++    +Ω...A++    +++++++
+ data/scenarios/Tutorials/stock.yaml view
@@ -0,0 +1,78 @@+version: 1+name: Stock+description: |+  Learn how to stock inventory when building robots.+objectives:+  - goal:+      - |+        In the previous tutorial challenge, you learned how to use `require`{=snippet}+        to require specific devices to be equipped.+        Sometimes, instead of requiring entities to be equiped as devices, you need them to be stocked in your inventory.+      - |+        In this case, you can write `stock <int> <name>`{=snippet} to ensure that a certain number+        of copies of a certain entity are placed in your inventory. For example:+        ```+        build {stock 2 "flower"; move; place "flower"; move; place "flower"}+        ```+        This would build a robot with two `flower`{=entity}s in its inventory which the robot can then place.+      - Your goal in this challenge is to cover the entire 4x4 gray area with `rock`{=entity}s!+      - |+        **TIP:** You can define commands to simplify your task, for example:+        `def r = move; place "rock"; end`+    condition: |+      def forM = \i.\e. \c. if (i >= e) {} {c i; forM (i+1) e c} end;+      def ifC = \test. \then. \else. b <- test; if b then else end;++      try {+        turn east;+        forM 1 5 (\y.+          forM 1 5 (\x.+            teleport self (x,-y);+            ifC (ishere "rock") {} {grab; noop};+          );+        );+        pure true+      } { pure false }+solution: |+  def x4 = \c. c;c;c;c end;+  def mp = move; place "rock" end;+  def rr = turn right; move; turn right; x4 mp; turn back; x4 move end;+  build {+    stock 16 "rock";+    x4 rr+  };+robots:+  - name: base+    heavy: true+    dir: north+    display:+      char: Ω+      attr: robot+    devices:+      - logger+      - 3D printer+      - dictionary+    inventory:+      - [16, compass]+      - [16, solar panel]+      - [16, logger]+      - [16, treads]+      - [16, grabber]+      - [16, scanner]+      - [16, lambda]+      - [100, rock]+world:+  palette:+    "Ω": [grass, null, base]+    ".": [grass]+    "_": [stone]+    "+": [stone, wall]+  upperleft: [-1, 1]+  map: |+    ++++++++    +Ω....++    +.____++    +.____++    +.____++    +.____++    +++++++
data/scenarios/Tutorials/type-errors.yaml view
@@ -21,8 +21,8 @@     condition: |       try {         w <- as base {has "Win"};-        return (not w);-      } { return false }+        pure (not w);+      } { pure false } entities:   - name: Win     display:@@ -47,15 +47,10 @@   palette:     '>': [grass, null, base]     '.': [grass]-    '┌': [stone, upper left corner]-    '┐': [stone, upper right corner]-    '└': [stone, lower left corner]-    '┘': [stone, lower right corner]-    '─': [stone, horizontal wall]-    '│': [stone, vertical wall]+    '+': [stone, wall]   upperleft: [-1, 1]   map: |-    ┌───┐-    │>..│-    │...│-    └───┘+    ++++++    +>..++    +...++    +++++
data/scenarios/Tutorials/types.yaml view
@@ -25,8 +25,8 @@     condition: |       try {         w <- as base {has "Win"};-        return (not w);-      } { return false }+        pure (not w);+      } { pure false } entities:   - name: Win     display:@@ -51,15 +51,10 @@   palette:     '>': [grass, null, base]     '.': [grass]-    '┌': [stone, upper left corner]-    '┐': [stone, upper right corner]-    '└': [stone, lower left corner]-    '┘': [stone, lower right corner]-    '─': [stone, horizontal wall]-    '│': [stone, vertical wall]+    '+': [stone, wall]   upperleft: [-1, 1]   map: |-    ┌───┐-    │>..│-    │...│-    └───┘+    ++++++    +>..++    +...++    +++++
data/scenarios/Tutorials/world101.sw view
@@ -4,15 +4,17 @@  def m = move end def m2 = m;m end+def m3 = m;m;m end def m4 = m2;m2 end+def m5 = m4;m end def m8 = m4;m4 end-def m9 = m8;m end-def m10 = m8;m2 end+def m12 = m4;m8 end+def m26 = m12;m12;m2 end  def mg = m; grab end  def get_3_trees : Cmd Unit =-  tB; m; mg; mg; mg; tB; m4+  tL; m; tL; m3; grab; tR; m; tL; mg; mg; tB; m5; tR; m2 end  def make_harvester : Cmd Unit =@@ -24,13 +26,13 @@ end  def get_lambda : Cmd Unit =-  m10; tR; m9; harvest; tB; m9; tL; m10+  m12; tL; m26; harvest; tB; m26; tR; m12 end  def solution : Cmd Unit =-  build {get_3_trees}; wait 16; salvage;+  build {get_3_trees}; wait 24; salvage;   make_harvester;-  build {get_lambda}; wait 50; salvage+  build {get_lambda}; wait 100; salvage end;  solution
data/scenarios/Tutorials/world101.yaml view
@@ -10,17 +10,18 @@       - You can see that your base starts out with some key devices equipped and some basic supplies for building robots.  To build more advanced devices and produce more robots, you'll need to explore, gather resources, and set up some automated production pipelines.       - At this point you may want to create an external `.sw`{=path} file with useful definitions you create.  You can then load it via the `run` command.  See https://github.com/swarm-game/swarm/tree/main/editors for help configuring your editor with support for swarm-lang.       - Your first task is to collect three or more `tree`{=entity}s. You can remind yourself of the available commands using **F4**.+      - Since you don't yet have a `compass`{=entity} device, you won't be able to refer to cardinal directions like `north` or `east`, only relative directions like `left`, `right`, or `back`.     condition: |       try {         n <- as base {count "tree"};-        return (n >= 3)-      } { return false }+        pure (n >= 3)+      } { pure false }   - id: get_harvester     teaser: Make a harvester     goal:       - Nice work!  Now, use the `tree`{=entity}s to make a `harvester`{=entity} device. This will require several intermediate products; try making various things, and take a look at your available recipes (**F3**) and at the recipes listed for items in your inventory.  Of course, you may end up needing some additional trees.     condition: |-      try { as base {has "harvester"} } {return false}+      try { as base {has "harvester"} } {pure false}     prerequisite: get_trees   - goal:       - Now that you have a `harvester`{=entity}, you can use `harvest` instead of `grab` whenever you pick up a growing item (check for the word "growing" at the top of the item description), to leave behind a seed that will regrow.@@ -28,7 +29,7 @@       - One of the next things you will probably want is a `lambda`{=entity}, so you can define and use parameterized commands.  Scan some things and use the process of elimination to find one.  Since lambdas regrow, once you find one, try getting it with `harvest`.       - "**TIP:** remember that you can click on cells in the world to see their coordinates."     condition: |-      try { as base {has "lambda"} } {return false}+      try { as base {has "lambda"} } {pure false}     prerequisite: get_harvester solution: |   run "scenarios/Tutorials/world101.sw"@@ -57,9 +58,8 @@       - [100, solar panel]       - [50, scanner]       - [5, toolkit]-seed: 0+seed: 2 world:-  offset: true   scrollable: false   dsl: |     "classic"
data/scenarios/Vignettes/00-ORDER.txt view
@@ -1,1 +1,2 @@ roadway.yaml+progress-bar.yaml
data/scenarios/Vignettes/_roadway/coordinator.sw view
@@ -9,13 +9,13 @@     teleport self newLoc;     retval <- f;     teleport self prevLoc;-    return retval;+    pure retval;     end;  def swapItem = \ent.   create ent;   emptyHere <- isempty;-  if emptyHere {} {grab; return ()};+  if emptyHere {} {grab; pure ()};   place ent;   end;
data/scenarios/Vignettes/_roadway/drone.sw view
@@ -1,17 +1,17 @@ def elif = \t. \then. \else. {if t then else} end def else = \t. t end -def sumTuples = \t1. \t2.-    (fst t1 + fst t2, snd t1 + snd t2);+def λmatch = \f. \p. match p f end++def sumTuples = λmatch \t11. \t12. λmatch \t21. \t22.+    (t11 + t21, t12 + t22);     end;  def max = \a. \b.     if (a > b) {a} {b};     end; -def mapTuple = \f. \t.-    (f $ fst t, f $ snd t)-    end;+def mapTuple = \f. λmatch \x. \y. (f x, f y) end;  // modulus function (%) def mod : Int -> Int -> Int = \i.\m.@@ -34,11 +34,11 @@     let topCorner = (-18, 30) in     absloc <- whereami;     let loc = sumTuples absloc $ mapTuple (\x. -x) topCorner in-    let xloc = abs $ fst loc in+    match loc \x. \y.+    let xloc = abs x in     let idx = xloc / 2 in+    let yloc = abs y in -    let yloc = abs (snd loc) in-         randoffset <- random 5;     let baseoffset = 10 * idx in     let offset = randoffset + baseoffset in@@ -56,15 +56,16 @@             (west, (extents.xMax - offset, lanes.yWest))         }     } in-    turn $ fst locdir;-    teleport self $ snd locdir;-    return (isLongitudinal, idx);+    match locdir \dir. \loc.+    turn dir;+    teleport self loc;+    pure (isLongitudinal, idx);     end;  def isGreenLight = \isLongitudinal.     r <- robotnamed "stoplight";     isGreen <- as r {has "bit (1)"};-    return $ isLongitudinal != isGreen;+    pure $ isLongitudinal != isGreen;     end;  def getCanMove :@@ -75,44 +76,46 @@      d <- heading;     loc <- whereami;+    match loc \x. \y.     let atStopLine = if (d == north) {-        snd loc == stoplines.yNorth;+        y == stoplines.yNorth;     } $ elif (d == south) {-        snd loc == stoplines.ySouth;+        y == stoplines.ySouth;     } $ elif (d == east) {-        fst loc == stoplines.xEast;+        x == stoplines.xEast;     } $ else {         // west-        fst loc == stoplines.xWest;+        x == stoplines.xWest;     } in      eitherNeighbor <- meet;     // TODO: Make sure we only consider the neighbor directly in front of us.     neighborIsStopped <- case eitherNeighbor-        (\_. return false)+        (\_. pure false)         (\r. as r {has "bit (0)"}); // zero-bit means stopped -    return $ hasGreenLight || not (atStopLine || neighborIsStopped);+    pure $ hasGreenLight || not (atStopLine || neighborIsStopped);     end;  def doTunnelWrap : [xMin : Int, xMax : Int, yMin : Int, yMax : Int] -> Cmd Bool = \extents.     myloc <- whereami;-    didWrap <- if (fst myloc < extents.xMin) {-        teleport self (extents.xMax, snd myloc);-        return true;-    } $ elif (fst myloc > extents.xMax) {-        teleport self (extents.xMin, snd myloc);-        return true;-    } $ elif (snd myloc < extents.yMin) {-        teleport self (fst myloc, extents.yMax);-        return true;-    } $ elif (snd myloc > extents.yMax) {-        teleport self (fst myloc, extents.yMin);-        return true;+    match myloc \myx. \myy.+    didWrap <- if (myx < extents.xMin) {+        teleport self (extents.xMax, myy);+        pure true;+    } $ elif (myx > extents.xMax) {+        teleport self (extents.xMin, myy);+        pure true;+    } $ elif (myy < extents.yMin) {+        teleport self (myx, extents.yMax);+        pure true;+    } $ elif (myy > extents.yMax) {+        teleport self (myx, extents.yMin);+        pure true;     } $ else {-        return false;+        pure false;     };-    return didWrap;+    pure didWrap;     end;  def moveWithWrap :@@ -129,7 +132,7 @@         move;         doTunnelWrap extents;     } {-        return false;+        pure false;     };      try {@@ -137,7 +140,7 @@         if canMove {make "bit (1)"} {make "bit (0)"}     } {}; -    return (canMove, wentThroughTunnel);+    pure (canMove, wentThroughTunnel);     end;  def getNewDelayState :@@ -176,8 +179,7 @@     wait delayState.moveDelay;      result <- instant $ moveWithWrap stoplines extents isLongitudinal;-    let canGo = fst result in-    let wentThroughTunnel = snd result in+    match result \canGo. \wentThroughTunnel.     if wentThroughTunnel {         r <- random 50;         wait $ idx * 10 + r;@@ -192,8 +194,7 @@     let lanes = [yWest = 7, yEast = 5, xSouth = 20, xNorth = 22] in     let stoplines = [xWest = 24, xEast = 17, ySouth = 9, yNorth = 2] in     result <- instant $ init extents lanes;-    let isLongitudinal = fst result in-    let idx = snd result in+    match result \isLongitudinal. \idx.     advance idx isLongitudinal stoplines extents [moveDelay=5, transitionCountdown=2];     end;
+ data/scenarios/Vignettes/progress-bar.yaml view
@@ -0,0 +1,179 @@+version: 1+name: Progress bar+description: |+  A progress bar example that gradually fills up.+seed: 0+objectives:+  - goal:+      - Wait for all progress bars to fill up.+    condition: |+      turn east;+      let c = e <- scan down; if (e != inr "tree") {fail "not done"} {} in+      teleport self (1,-1); c; move; c; move; c; move; c; move; c; move; c; move; c; move; c; move; c; move; c;+      teleport self (1,-5); c; move; c; move; c; move; c; move; c; move; c; move; c; move; c; move; c; move; c;+      teleport self (1,-9); c; move; c; move; c; move; c; move; c; move; c; move; c; move; c; move; c; move; c;+      pure true+solution: |+  wait 100;+robots:+  - name: base+    dir: east+    devices:+      - treads+      - logger+      - grabber+  - name: fill+    system: true+    dir: east+    devices:+      - logger+    inventory:+      - [10, tree]+    program: |+      let repeat = \n.\c. if (n == 0) {} {c; repeat (n-1) c} in+      p <- whereami;+      match p \_. \y.+      repeat 10 (place "tree"; wait (-y); move)+known: [tree]+entities:+  - {name: Letter A, display: {char: "A"}, description: ["The letter A"], properties: [known]}+  - {name: Letter B, display: {char: "B"}, description: ["The letter B"], properties: [known]}+  - {name: Letter C, display: {char: "C"}, description: ["The letter C"], properties: [known]}+  - {name: Letter D, display: {char: "D"}, description: ["The letter D"], properties: [known]}+  - {name: Letter E, display: {char: "E"}, description: ["The letter E"], properties: [known]}+  - {name: Letter F, display: {char: "F"}, description: ["The letter F"], properties: [known]}+  - {name: Letter G, display: {char: "G"}, description: ["The letter G"], properties: [known]}+  - {name: Letter H, display: {char: "H"}, description: ["The letter H"], properties: [known]}+  - {name: Letter I, display: {char: "I"}, description: ["The letter I"], properties: [known]}+  - {name: Letter J, display: {char: "J"}, description: ["The letter J"], properties: [known]}+  - {name: Letter K, display: {char: "K"}, description: ["The letter K"], properties: [known]}+  - {name: Letter L, display: {char: "L"}, description: ["The letter L"], properties: [known]}+  - {name: Letter M, display: {char: "M"}, description: ["The letter M"], properties: [known]}+  - {name: Letter N, display: {char: "N"}, description: ["The letter N"], properties: [known]}+  - {name: Letter O, display: {char: "O"}, description: ["The letter O"], properties: [known]}+  - {name: Letter P, display: {char: "P"}, description: ["The letter P"], properties: [known]}+  - {name: Letter Q, display: {char: "Q"}, description: ["The letter Q"], properties: [known]}+  - {name: Letter R, display: {char: "R"}, description: ["The letter R"], properties: [known]}+  - {name: Letter S, display: {char: "S"}, description: ["The letter S"], properties: [known]}+  - {name: Letter T, display: {char: "T"}, description: ["The letter T"], properties: [known]}+  - {name: Letter U, display: {char: "U"}, description: ["The letter U"], properties: [known]}+  - {name: Letter V, display: {char: "V"}, description: ["The letter V"], properties: [known]}+  - {name: Letter W, display: {char: "W"}, description: ["The letter W"], properties: [known]}+  - {name: Letter X, display: {char: "X"}, description: ["The letter X"], properties: [known]}+  - {name: Letter Y, display: {char: "Y"}, description: ["The letter Y"], properties: [known]}+  - {name: Letter Z, display: {char: "Z"}, description: ["The letter Z"], properties: [known]}+  - {name: Letter a, display: {char: "a"}, description: ["The letter a"], properties: [known]}+  - {name: Letter b, display: {char: "b"}, description: ["The letter b"], properties: [known]}+  - {name: Letter c, display: {char: "c"}, description: ["The letter c"], properties: [known]}+  - {name: Letter d, display: {char: "d"}, description: ["The letter d"], properties: [known]}+  - {name: Letter e, display: {char: "e"}, description: ["The letter e"], properties: [known]}+  - {name: Letter f, display: {char: "f"}, description: ["The letter f"], properties: [known]}+  - {name: Letter g, display: {char: "g"}, description: ["The letter g"], properties: [known]}+  - {name: Letter h, display: {char: "h"}, description: ["The letter h"], properties: [known]}+  - {name: Letter i, display: {char: "i"}, description: ["The letter i"], properties: [known]}+  - {name: Letter j, display: {char: "j"}, description: ["The letter j"], properties: [known]}+  - {name: Letter k, display: {char: "k"}, description: ["The letter k"], properties: [known]}+  - {name: Letter l, display: {char: "l"}, description: ["The letter l"], properties: [known]}+  - {name: Letter m, display: {char: "m"}, description: ["The letter m"], properties: [known]}+  - {name: Letter n, display: {char: "n"}, description: ["The letter n"], properties: [known]}+  - {name: Letter o, display: {char: "o"}, description: ["The letter o"], properties: [known]}+  - {name: Letter p, display: {char: "p"}, description: ["The letter p"], properties: [known]}+  - {name: Letter q, display: {char: "q"}, description: ["The letter q"], properties: [known]}+  - {name: Letter r, display: {char: "r"}, description: ["The letter r"], properties: [known]}+  - {name: Letter s, display: {char: "s"}, description: ["The letter s"], properties: [known]}+  - {name: Letter t, display: {char: "t"}, description: ["The letter t"], properties: [known]}+  - {name: Letter u, display: {char: "u"}, description: ["The letter u"], properties: [known]}+  - {name: Letter v, display: {char: "v"}, description: ["The letter v"], properties: [known]}+  - {name: Letter w, display: {char: "w"}, description: ["The letter w"], properties: [known]}+  - {name: Letter x, display: {char: "x"}, description: ["The letter x"], properties: [known]}+  - {name: Letter y, display: {char: "y"}, description: ["The letter y"], properties: [known]}+  - {name: Letter z, display: {char: "z"}, description: ["The letter z"], properties: [known]}+structures:+  - name: progress+    structure:+      palette:+        '+': [stone, wall]+        '.': [stone]+        '-': [stone, null, fill]+      map: |+        +++++++++++++        +-.........++        +++++++++++++world:+  dsl: |+    {grass}+  palette:+    '~': [grass, null, base]+    '.': [grass]+    ' ': [grass]+    '$':+      structure:+        name: progress+      cell: [stone]+    'A': [grass, Letter A]+    'B': [grass, Letter B]+    'C': [grass, Letter C]+    'D': [grass, Letter D]+    'E': [grass, Letter E]+    'F': [grass, Letter F]+    'G': [grass, Letter G]+    'H': [grass, Letter H]+    'I': [grass, Letter I]+    'J': [grass, Letter J]+    'K': [grass, Letter K]+    'L': [grass, Letter L]+    'M': [grass, Letter M]+    'N': [grass, Letter N]+    'O': [grass, Letter O]+    'P': [grass, Letter P]+    'Q': [grass, Letter Q]+    'R': [grass, Letter R]+    'S': [grass, Letter S]+    'T': [grass, Letter T]+    'U': [grass, Letter U]+    'V': [grass, Letter V]+    'W': [grass, Letter W]+    'X': [grass, Letter X]+    'Y': [grass, Letter Y]+    'Z': [grass, Letter Z]+    'a': [grass, Letter a]+    'b': [grass, Letter b]+    'c': [grass, Letter c]+    'd': [grass, Letter d]+    'e': [grass, Letter e]+    'f': [grass, Letter f]+    'g': [grass, Letter g]+    'h': [grass, Letter h]+    'i': [grass, Letter i]+    'j': [grass, Letter j]+    'k': [grass, Letter k]+    'l': [grass, Letter l]+    'm': [grass, Letter m]+    'n': [grass, Letter n]+    'o': [grass, Letter o]+    'p': [grass, Letter p]+    'q': [grass, Letter q]+    'r': [grass, Letter r]+    's': [grass, Letter s]+    't': [grass, Letter t]+    'u': [grass, Letter u]+    'v': [grass, Letter v]+    'w': [grass, Letter w]+    'x': [grass, Letter x]+    'y': [grass, Letter y]+    'z': [grass, Letter z]+  map: |-+    $...............................+    .............First progress bar.+    ................................+    ......................~.........+    $...............................+    .............Second progress bar+    ................................+    ................................+    $...............................+    .............Third progress bar.+    ................................+    ................................+    abcdefghijklmnopqrstuvwxyz......+    ABCDEFGHIJKLMNOPQRSTUVWXYZ......
data/scenarios/World Examples/clearing.yaml view
@@ -14,9 +14,16 @@     dir: north world:   dsl: |-    overlay+    let // Weight the y coordinates used for the radius calculation+        // by 2.  This will result in an ellipse of half the height,+        // which will look circular thanks to the non-square display.+        radiussq = x*x + (2*y)*(2*y),+        inner = radiussq < 6*6,+        outer = radiussq > 30*30,+        middle = not inner && not outer+    in overlay     [ {dirt}-    , mask ((x*x + 4*y*y) >= (6*6) && (x*x + 4*y*y) <= (30*30))-        (let h = hash % 24 in if (36 + h*h) <= (x*x + 4*y*y) then {tree,dirt} else {dirt} )-    , mask ((x*x + 4*y*y) > (30*30)) {tree, dirt}+    , mask middle+      (let h = hash % 24 in if (36 + h*h) <= radiussq then {tree,dirt} else {dirt})+    , mask outer {tree, dirt}     ]
data/scenarios/classic.yaml view
@@ -29,7 +29,135 @@       - [50, clock]       - [5, toolkit] world:-  offset: true   scrollable: false   dsl: |     "classic"+objectives:+  - id: trees+    teaser: Trees+    goal:+      - |+        Some goals will be shown here, to gently nudge you towards+        some useful accomplishments if you'd like some guidance.+        However, these goals are optional!  Feel free to ignore them+        and choose your own path.+      - |+        One of the first things you will probably want is a few `tree`{=entity}s.+        Collect at least 10.+    optional: true+    condition: |+      as base { n <- count "tree"; pure (n >= 10) }+  - id: lambda+    teaser: Lambda+    goal:+      - |+        It's useful to be able to give names to sequences of commands,+        *i.e.* procedures, via `def`{=snippet}.  But what's *really*+        useful is the ability to define parameterized *functions*!+        For that, you'll need to find a `lambda`{=entity}.+    optional: true+    condition: |+      as base { has "lambda" }+  - id: harvester+    teaser: Harvester+    goal:+      - |+        Construct a `harvester`{=entity}, so you can grow things like+        trees and lambdas in a sustainable way.+    optional: true+    prerequisite: trees+    condition: |+      as base { has "harvester" }+  - id: boat+    teaser: Boat+    goal:+      - |+        Construct a `boat`{=entity}, which can be used by robots to+        float across `water`{=entity}.+    optional: true+    prerequisite: trees+    condition: |+      as base { has "boat" }+  - id: logs+    teaser: Tree farm+    goal:+      - |+        What you really need is a steady *supply* of wood.  Collect+        at least 256 `log`{=entity}s.+    optional: true+    prerequisite: trees+    condition: |+      as base { n <- count "log"; pure (n >= 256) }+  - id: furnace+    teaser: Furnace+    goal:+      - |+        Collect at least five `rock`{=entity}s and make a `furnace`{=entity}.+    optional: true+    condition: |+      as base { h <- has "furnace"; e <- equipped "furnace"; pure (h || e) }+  - id: bits+    teaser: Bits+    goal:+      - |+        Collect some bits: at least eight 0 bits and eight 1 bits.+    optional: true+    condition: |+      as base {+        zs <- count "bit (0)";+        os <- count "bit (1)";+        pure (zs >= 8 && os >= 8)+      }+  - id: wire+    teaser: Wire+    goal:+      - |+        Now that you have a furnace, you can use it to craft a few+        different items requiring heat.  Collect some `copper+        ore`{=entity} and make some `copper wire`{=entity}.+    optional: true+    prerequisite: furnace+    condition: |+      as base { has "copper wire" }+  - id: drill+    teaser: Drill+    goal:+      - |+        Now make a `drill`{=entity}, which can be used to clear+        `boulder`{=entity}s out of the way and mine for resources in+        the mountains.  Making a `drill`{=entity} requires first+        making several intermediate components, but you're well on+        your way.  Try exploring the available recipes for each item+        in your inventory.+    optional: true+    prerequisite:+      logic:+        and:+          - wire+          - bits+          - trees+    condition: |+      as base { has "drill" }+  - id: ore+    teaser: Ore+    goal:+      - |+        Now that you have a `drill`{=entity}, you can use it to search+        for mines: `drill forward` while next to a+        `mountain`{=entity}, which will yield either a `mountain+        tunnel`{=entity} that no longer blocks your way, or some kind+        of mine.  `drill down` in a mine to extract ore.+      - |+        Establish some mines and collect both `copper ore`{=entity}+        and `iron ore`{=entity}.+    optional: true+    prerequisite: drill+    condition: |+      as base { i <- has "iron ore"; c <- has "copper ore"; pure (i && c) }+  - id: unwinnable+    goal:+      - |+        The classic scenario is not actually winnable (yet).+    hidden: true+    condition: |+      pure false
data/scenarios/creative.yaml view
@@ -11,6 +11,5 @@       char: Ω       attr: robot world:-  offset: true   dsl: |     "classic"
data/terrains.yaml view
@@ -14,3 +14,7 @@   attr: ice   description: |     Cold, solid, and slippery.+- name: burnt+  attr: burnt+  description: |+    Scorched ground
+ data/test/language-snippets/format/2105.sw view
@@ -0,0 +1,1 @@+if true {(1, 2)} /* comment */ {(3, 4)}
+ data/test/language-snippets/format/def.sw view
@@ -0,0 +1,1 @@+def f = \n. 2 /* comment */ end // post
+ data/test/language-snippets/format/defs.sw view
@@ -0,0 +1,8 @@+// Comment about this definition+def f: Int -> Int = \n. n + 2 /* after lambda */ end++// Comment about another definition+// More comments+/* block+   comment */+def g: Text = "hello" end
+ data/test/language-snippets/format/infix.sw view
@@ -0,0 +1,1 @@+1 + /* infix comment */ 2
+ data/test/language-snippets/format/infix2.sw view
@@ -0,0 +1,1 @@+1 /* infix comment */ + 2
+ data/test/language-snippets/format/infix3.sw view
@@ -0,0 +1,1 @@+1 + (2 + 3 /* infix comment */)
+ data/test/language-snippets/format/lambda.sw view
@@ -0,0 +1,2 @@+// pre+\n. n + 1 /* comment */
+ data/test/language-snippets/format/lambda2.sw view
@@ -0,0 +1,2 @@+// pre+(\n. n + 1) /* comment */
+ data/test/language-snippets/format/list.sw view
@@ -0,0 +1,287 @@+/*******************************************************************/+/*                       LIST ENCODING IN INT                      */+/*                                                                 */+/* This file defines functions that allow storing arbitrary list   */+/* of values in one integer. It is possible because an integer can */+/* have unlimited length and can be split into chunks of smaller   */+/* integers. See Haskell docs for Integer (used by swarm for int). */+/*                                                                 */+/* For examples of usage see the unit tests in testLIST function.  */+/*                                                                 */+/* NOTE THAT THIS IS NOT EFFICIENT OR ERGONIMIC!!! YOU SHOULD USE: */+tydef NormalListType a = rec l. Unit + (a * l) end++/*                                                                 */+/* This code was written before swarm had 'format' or 'rec', but   */+/* it still serves as an example of pure swarm code with tests.    */+/*******************************************************************/+//+// Definitions:+// - MAIN: nil (Haskell []), cons (Haskell (:)), head, tail+// - BONUS: headTail, index, for, for_each, for_each_i+// - ARITH: len, mod, shiftL, shiftR, shiftLH, shiftRH+// - HELPERS: consP, getLenPart, setLenPart, to1numA, getLenA+// - TESTS: assert, testLIST, testLIST_BIG, testLIST_ALL+//+/*******************************************************************/+/*                              TYPE                               */+/*******************************************************************/+// Type of list of ints - the inner ints can themselves be lists,+// so *any* type can be encoded inside.+//+// It is the callers responsibility to make sure a program using this+// "type" is type safe. Notably 2 == [0] != [] == 0 but [] !! x == 0.+tydef ListI = Int end++/*******************************************************************/+/*                             LAYOUT                              */+/*******************************************************************/+// The length of a number is kept in the header and split into 7bit+// chunks each prefixed by 1bit that marks if the byte is last in+// the header (0=YES).+/* EXAMPLE - [short_x,long_y] - concretly e.g. [42, 2^(2^7)]++0   < len short_x < 2^7+2^7 < len long_y  < 2^14++cons short_x   $          cons long_y          $ nil+vvvvvvvvvvvv       vvvvvvvvvvvvvvvvvvvvvvvvv     vvv+  0|len x|x    |   1|len y%2^7|0|len y/2^7|y   |  0+^^^^^^^^^^^^       ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^+  head                         tail+*/+/*******************************************************************/+/*                         ARITH PRIMITIVES                        */+/*******************************************************************/+// bitlength of a number (shifting by one)+def naive_len: Int -> Int -> Int +  = \acc. \i.+  if (i == 0) {acc} {naive_len (1 + acc) (i / 2)}+end++// modulus function (%)+def mod: Int -> Int -> Int = \i. \m. i - m * (i / m) end++// f X Y = Y * 2^(-X)+def shiftL: Int -> Int -> Int = \s. \i. i / 2 ^ s end++// f X Y = Y * 2^(X)+def shiftR: Int -> Int -> Int = \s. \i. i * 2 ^ s end++// shift by (8bit) bytes+def shiftLH: Int -> Int -> Int = \s. shiftL (s * 8) end++def shiftRH: Int -> Int -> Int = \s. shiftR (s * 8) end++// bitlength of a number using an accumulator (shifting by 64)+def len_accum: Int -> Int -> Int +  = \acc. \i.+  let next = i / 2 ^ 64 in+  if (next == 0) {naive_len acc i} {len_accum (acc + 64) next}+end++// bitlength of a number (uses an accumulator and shifts by 64 bits)+def len: Int -> Int = len_accum 0 end++/*******************************************************************/+/*                       helper functions                          */+/*******************************************************************/+def getLenPart: Int -> Int = \i. mod (i / 2) (2 ^ 7) end++def setLenPart: Int -> Int = \i. 2 * mod i (2 ^ 7) end++// Split length into 7-bit parts and prefix all but last with 1+def to1numA: Int -> (Int * Int) +  = \i.+  let nextPart = shiftL 7 i in+  if (nextPart == 0) {+    // last part+    (2 * i, 1)+  } {+    let p = to1numA nextPart in+    (1 /* header isEnd bit */ + setLenPart i + shiftRH 1 (fst p), 1 + snd p)+  }+end++// Get bitlength of the first number in the list+// and also the list starting at the number itself+def getLenA: ListI -> (Int * Int) +  = \xs.+  let isEnd = 0 == mod xs 2 in+  let l = getLenPart xs in+  let nextPart = shiftLH 1 xs in+  if isEnd {(l, nextPart)} {+    let p = getLenA nextPart in (l + shiftR 7 (fst p), snd p)+  }+end++/*******************************************************************/+/*                         LIST FUNCTIONS                          */+/*******************************************************************/+def headTail: ListI -> (Int * ListI) +  = \xs.+  let sign = mod xs 2 in+  let ns = xs / 2 in+  let p = getLenA ns in+  ( let x = mod (snd p) $ 2 ^ fst p in if (sign == 0) {x} {-x}+  , shiftL (fst p) (snd p) )+end++def head: ListI -> Int +  = \xs.+  let sign = mod xs 2 in+  let ns = xs / 2 in+  let p = getLenA ns in+  let x = mod (snd p) $ 2 ^ fst p in if (sign == 0) {x} {-x}+end++def tail: ListI -> ListI +  = \xs.+  let sign = mod xs 2 in+  let ns = xs / 2 in let p = getLenA ns in shiftL (fst p) (snd p)+end++def nil: ListI = 0 end++// Add non-negative number to beginning of list (cons adds the sign)+def consP: Int -> ListI -> Int +  = \x. \xs.+  if (x == 0) {2 /* header says one bit length */ + shiftR (8 + 1) xs} {+    let l = len x in+    let pl = to1numA l in fst pl + shiftRH (snd pl) (x + shiftR l xs)+  }+end++// Add integer to the beginning of the list+def cons: Int -> ListI -> ListI +  = \x. \xs.+  if (x >= 0) {2 * consP x xs} {1 + 2 * consP (-x) xs}+end++/*******************************************************************/+/*                       MORE LIST FUNCTIONS                       */+/*******************************************************************/+def index: Int -> ListI -> Int +  = \i. \xs.+  if (i <= 0) {head xs} {index (i - 1) (tail xs)}+end++def for: ∀ a. Int -> Int -> (Int -> Cmd a) -> Cmd Unit +  = \s. \e. \act.+  if (s == e) {} {act s; for (s + 1) e act}+end++def for_each_i: Int -> ListI -> (Int -> Int -> Cmd Unit) -> Cmd Unit +  = \i. \xs. \act.+  if (xs == nil) {} {+    let ht = headTail xs in act i (fst ht); for_each_i (i + 1) (snd ht) act+  }+end++def for_each: ListI -> (Int -> Cmd Unit) -> Cmd Unit +  = \xs. \act.+  for_each_i 0 xs (\i. act)+end++/*******************************************************************/+/*                           UNIT TESTS                            */+/*******************************************************************/+def assert = \b. \m. if b {} {log "FAIL:"; fail m} end++def assert_eq +  = \exp. \act. \m.+  if (exp == act) {} {+    log ("FAIL: expected " ++ format exp ++ " actual " ++ format act);+    fail m+  }+end++def testLIST =+  log "STARTING TESTS OF LIST:";+  log "check [0]";+  let l0 = cons 0 nil in+  assert_eq l0 4 "[0] ~ 4";+  assert_eq (head l0) 0 "head [0] == 0";+  assert_eq (tail l0) nil "tail [0] == []";+  log "check [1]";+  let l1 = cons 1 nil in+  assert_eq l1 516 "[1] ~ 516";+  assert_eq (head l1) 1 "head [1] == 1";+  assert_eq (tail l1) nil "tail [1] == []";+  log "check [-1]";+  let ln1 = cons (-1) nil in+  assert_eq ln1 517 "[-1] ~ 517";+  assert_eq (head ln1) (-1) "head [-1] == -1";+  assert_eq (tail ln1) nil "tail [-1] == []";+  log "check [42]";+  let l42 = cons 42 nil in+  assert_eq l42 21528 "[42] ~ 21528";+  assert_eq (head l42) 42 "head [42] == 42";+  assert_eq (tail l42) nil "tail [42] == []";+  log "check [499672]";+  let l499672 = cons 499672 nil in+  assert_eq l499672 255832140 "[499672] ~ 255832140";+  assert_eq (head l499672) 499672 "head [499672] == 499672";+  assert_eq (tail l499672) nil "tail [499672] == []";+  log "check [1,0]";+  let l1_0 = cons 1 l0 in+  assert_eq l1_0 4612 "[1,0] ~ 4612";+  assert_eq (head l1_0) 1 "head [1,0] == 1";+  assert_eq (tail l1_0) l0 "tail [1,0] == [0]";+  log "check [11,1,0]";+  let l11_1_0 = cons 11 l1_0 in+  assert_eq (head l11_1_0) 11 "head [11,1,0] == 11";+  assert_eq (tail l11_1_0) l1_0 "tail [11,1,0] == [1,0]";+  log "check [0..9]";+  let l0__9 =+    cons 0 $ cons 1 $ cons 2 $ cons 3 $ cons 4 $ cons 5 $ cons 6 $ cons 7 $ cons 8 $ cons 9 nil in+  assert_eq (head l0__9) 0 "head [0..9] == 0";+  log "- check indices";+  assert_eq (index 0 l0__9) 0 "[0..9] !! 0 == 0";+  assert_eq (index 9 l0__9) 9 "[0..9] !! 9 == 9";+  log "check for + index";+  for 0 9 (+    \i. log ("- at index " ++ format i);+    assert_eq (index i l0__9) i "[0..9] - every index I has value I"+  );+  log "check for_each";+  for_each l0__9 (+    \x. log ("- at value " ++ format x);+    assert (x < 10) "[0..9] - every value X < 10"+  );+  log "check for_each_i";+  for_each_i 0 l0__9 (+    \i. \x. log ("- at index " ++ format i);+    assert_eq i x "[0..9] - I == X for every value X at index I"+  );+  log "OK - ALL TEST PASSED\a"+end++// This tests uses VERY LONG lists of size up to 2097332 bits.+// TIP: increase the game speed (ticks/s) when you run this test.+def testLIST_BIG =+  log "STARTING TESTS OF BIG LISTS:";+  log "check [2^(2^7)] aka [big]";+  let big = 2 ^ 2 ^ 7 in+  assert_eq (len big) 129 "len (2^2^7) == 2^7+1";+  assert_eq (to1numA 129) ( 515+  , 2 ) "to1numA: 129 == 1000_0001 --> 515 == [0000 001 0] [0000 001 1]";+  assert_eq (getLenA 515) (129, nil) "getLenA: 515 --> 129";+  let ibig = 2 * (shiftR 16 big + 515) in+  let lbig = cons big nil in+  assert_eq lbig ibig "[big] ~ 2 * ((big * 2^(2*8)) + 515)";+  assert_eq (head lbig) big "head [big] == big";+  assert_eq (tail lbig) nil "tail [big] == []";+  log "check [2^(2^21)] aka [bigger]";+  let bigger = 2 ^ 2 ^ 21 in+  let lbigger = cons bigger nil in+  assert_eq (head lbigger) bigger "head [bigger] == bigger";+  assert_eq (tail lbigger) nil "tail [bigger] == []";+  log "check [2^(2^21),2^(2^7)] aka [bigger,big]";+  let lbiggest = cons bigger lbig in+  assert_eq (head lbiggest) bigger "head [bigger,big] == bigger";+  assert_eq (tail lbiggest) lbig "tail [bigger,big] == [big]";+  log "OK - ALL TEST PASSED"+end++def testLIST_ALL = testLIST; testLIST_BIG end
+ data/test/language-snippets/format/parens.sw view
@@ -0,0 +1,1 @@+(1 /* hi */)
+ data/test/language-snippets/format/prefix.sw view
@@ -0,0 +1,2 @@+// prefix comment+1 + 2
+ data/test/language-snippets/format/record.sw view
@@ -0,0 +1,2 @@+// pre+[x = 3 /* three */, y = "hi"] // post
+ data/test/language-snippets/format/suffix.sw view
@@ -0,0 +1,1 @@+1 + 2 /* suffix comment*/
+ data/test/language-snippets/warnings/unused-vars/lambda-with-annot.sw view
@@ -0,0 +1,1 @@+def put = \y. place (y : Text); end;
+ data/test/language-snippets/warnings/unused-vars/lambda-with-record-unused.sw view
@@ -0,0 +1,1 @@+def put = \y. [x = 3, z = 7]; end;
+ data/test/language-snippets/warnings/unused-vars/lambda-with-record-used-abbrev.sw view
@@ -0,0 +1,1 @@+def put = \y. [x = 3, y]; end;
+ data/test/language-snippets/warnings/unused-vars/lambda-with-record-used.sw view
@@ -0,0 +1,1 @@+def put = \y. [x = 3, z = y + 2]; end;
+ data/test/saves/backstory-0.6.0.0.yaml view
@@ -0,0 +1,58 @@+# obtained by:+# git checkout 0.6.0.0+# cabal run swarm -- --scenario Tutorials/Backstory --run <(echo 'say "Ready!"')+path: Tutorials/backstory.yaml+status:+  contents:+    - initialCode: /dev/fd/15+      seedVal: null+    - - Completed+      - attemptmetrics:+          codemetrics:+            astSize: 3+            sourceTextLength: 13+          durationmetrics:+            elapsed: 1.696629+            elapsedticks: 5+        started: 2025-02-12T16:05:31.987851+01:00+    - bestbyastsize:+        - Completed+        - attemptmetrics:+            codemetrics:+              astSize: 3+              sourceTextLength: 13+            durationmetrics:+              elapsed: 0.337978+              elapsedticks: 5+          started: 2025-02-12T16:05:31.987851+01:00+      bestbycharcount:+        - Completed+        - attemptmetrics:+            codemetrics:+              astSize: 3+              sourceTextLength: 13+            durationmetrics:+              elapsed: 0.337978+              elapsedticks: 5+          started: 2025-02-12T16:05:31.987851+01:00+      bestbyticks:+        - Completed+        - attemptmetrics:+            codemetrics:+              astSize: 3+              sourceTextLength: 13+            durationmetrics:+              elapsed: 0.337978+              elapsedticks: 5+          started: 2025-02-12T16:05:31.987851+01:00+      bestbytime:+        - Completed+        - attemptmetrics:+            codemetrics:+              astSize: 3+              sourceTextLength: 13+            durationmetrics:+              elapsed: 0.337978+              elapsedticks: 5+          started: 2025-02-12T16:05:31.987851+01:00+  tag: Played
+ data/test/saves/backstory-latest.yaml view
@@ -0,0 +1,63 @@+# obtained by:+# git checkout main+# cabal run swarm -- --scenario Tutorials/Backstory --run <(echo 'say "Ready!"')+path: Tutorials/backstory.yaml+status:+  contents:+    - initialCode: /dev/fd/15+      seedVal: null+    - data:+        attemptmetrics:+          codemetrics:+            astSize: 3+            sourceTextLength: 13+          durationmetrics:+            elapsed: 0.351809+            elapsedticks: 5+        started: 2025-02-12T22:40:26.141009+01:00+      progress: Completed+    - bestbyastsize:+        data:+          attemptmetrics:+            codemetrics:+              astSize: 3+              sourceTextLength: 13+            durationmetrics:+              elapsed: 0.351809+              elapsedticks: 5+          started: 2025-02-12T22:40:26.141009+01:00+        progress: Completed+      bestbycharcount:+        data:+          attemptmetrics:+            codemetrics:+              astSize: 3+              sourceTextLength: 13+            durationmetrics:+              elapsed: 0.351809+              elapsedticks: 5+          started: 2025-02-12T22:40:26.141009+01:00+        progress: Completed+      bestbyticks:+        data:+          attemptmetrics:+            codemetrics:+              astSize: 3+              sourceTextLength: 13+            durationmetrics:+              elapsed: 0.351809+              elapsedticks: 5+          started: 2025-02-12T22:40:26.141009+01:00+        progress: Completed+      bestbytime:+        data:+          attemptmetrics:+            codemetrics:+              astSize: 3+              sourceTextLength: 13+            durationmetrics:+              elapsed: 0.351809+              elapsedticks: 5+          started: 2025-02-12T22:40:26.141009+01:00+        progress: Completed+  tag: Played
data/test/standalone-topography/circle-and-crosses.yaml view
@@ -19,7 +19,7 @@               fff       placements:         - src: beam-          offset: [0, 3]+          offset: [0, 0]         - src: beam           offset: [-3, -3]           orient:@@ -55,5 +55,5 @@     orient:       up: west   - src: disc-    offset: [8, -8]+    offset: [5, -8] map: ""
+ data/test/standalone-topography/rainbow.png view

binary file changed (absent → 162 bytes)

+ data/test/standalone-topography/rainbow.yaml view
@@ -0,0 +1,28 @@+structures:+  - name: stripe+    structure:+      palette:+        'r': "#ff0000"+        'o': "#ff8800"+        'y': "#ffff00"+        'g': "#00ff00"+        'b': "#00ffff"+        'i': "#0000ff"+        'v': "#ff00ff"+      map: |+        roygbiv+mask: '.'+palette:+  'r':+    structure:+      name: stripe+      orientation:+        up: east+    cell: "#ffffff"+map: |+  ........rrrrr........+  .....rrr.....rrr.....+  ...rr...........rr...+  ..r...............r..+  .r.................r.+  r...................r
data/worlds/classic.world view
@@ -31,11 +31,11 @@        Boolean value associated to each coordinate.     */     big = pn0 > 0.0,  // 'big' is true for coordinates where pn0 > 0.0, and false otherwise-    hard = pn1 > 0.0, // etc.-    artificial = pn2 > 0.0,+    soft = pn1 > 0.0, // etc.+    natural = pn2 > 0.0,     small = not big,-    soft = not hard,-    natural = not artificial+    hard = not soft,+    artificial = not natural in /* The world is built up by a series of layers, with each layer thought of as a function    from coordinates to cell values.  The first layer is bottommost.@@ -75,6 +75,7 @@     [ {stone}     , mask (hash % 10 == 0) {stone, rock}     , mask (hash % 100 == 0) {stone, lodestone}+    , mask (hash % 300 == 0) {grass, parsley}     ]   ) , mask (big && soft && natural)@@ -88,6 +89,7 @@   ( overlay     [ {grass}     , mask (hash % 20 == 10) {grass, cotton}+    , mask (hash % 20 == 11) {grass, wheat}     , mask (hash % 20 == 0)  {grass, flower}     , mask (hash % 1000 == 1) {grass, tea plant}     ]@@ -97,6 +99,11 @@     [ {grass}     , mask (hash % 10 == 0)         (if (x + y) % 2 == 0 then {grass, bit (0)} else {grass, bit (1)})+    , mask (hash % 50 == 0)+        let i = (x - y) % 3 in+        if (i == 0) then {stone, pixel (R)}+        else if (i == 1) then {stone, pixel (G)}+        else {stone, pixel (B)}     ]   ) , mask (big && soft && artificial)@@ -109,12 +116,12 @@ , mask (small && hard && artificial)   ( overlay     [ {stone}-    , mask (hash % 50 == 0)-        let i = (x - y) % 3 in-        if (i == 0) then {stone, pixel (R)}-        else if (i == 1) then {stone, pixel (G)}-        else {stone, pixel (B)}-    , mask (hash % 120 == 1) {stone, lambda}+    , mask (hash % 2 == 0) {grass}+    , mask (hash % 120 == 1) {grass, lambda}+    , mask (hash % 80 == 2) {stone, copper ore}+    , mask (hash % 80 == 3) {grass, tree}+    , mask (hash % 80 == 4) {grass, rock}     ]   )+, mask (x*x + 4*y*y <= 25) {burnt, erase} ]
editors/emacs/swarm-mode.el view
@@ -91,11 +91,9 @@       "time"       "scout"       "whereami"-      "waypoint"-      "structure"+      "locateme"+      "structures"       "floorplan"-      "hastag"-      "tagmembers"       "detect"       "resonate"       "density"@@ -115,13 +113,16 @@       "setname"       "random"       "run"-      "return"+      "pure"       "try"+      "print"+      "erase"       "swap"       "atomic"       "instant"       "installkeyhandler"       "teleport"+      "warp"       "as"       "robotnamed"       "robotnumbered"@@ -145,6 +146,10 @@    "\\b"    (regexp-opt     '(+      "waypoint"+      "waypoints"+      "hastag"+      "tagmembers"       "self"       "parent"       "base"@@ -152,13 +157,13 @@       "inl"       "inr"       "case"-      "fst"-      "snd"+      "match"       "force"       "undefined"       "fail"       "not"       "format"+      "read"       "chars"       "split"       "charat"@@ -170,11 +175,11 @@   "Regexp that recognizes builtin for swarm language.")  (defvar swarm-mode-types-regexp-   "\\b[A-Z][a-zA-Z_]*\\b"+  "\\b[A-Z][a-zA-Z_]*\\b"   "Regexp that recognizes types (all uppercase strings are supposed to be types) in swarm language.")  (defvar swarm-mode-keywords-regexp-  (concat "\\b" (regexp-opt '("def" "tydef" "rec" "end" "let" "in" "require") t) "\\b")+  (concat "\\b" (regexp-opt '("def" "tydef" "rec" "end" "let" "in" "require" "stock") t) "\\b")   "Regexp that recognizes keywords in swarm language.")  (defvar swarm-font-lock-keywords@@ -195,12 +200,12 @@  (with-eval-after-load 'lsp-mode   (add-to-list 'lsp-language-id-configuration-    '(swarm-mode . "swarm"))+               '(swarm-mode . "swarm"))    (lsp-register-client-    (make-lsp-client :new-connection (lsp-stdio-connection (list "swarm" "lsp"))-                     :activation-fn (lsp-activate-on "swarm")-                     :server-id 'swarm-check)))+   (make-lsp-client :new-connection (lsp-stdio-connection (list "swarm" "lsp"))+                    :activation-fn (lsp-activate-on "swarm")+                    :server-id 'swarm-check)))  (provide 'swarm-mode) ;;; swarm-mode.el ends here
editors/vim/swarm.vim view
@@ -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 Keyword def tydef rec end let in require stock+syn keyword Builtins waypoint waypoints hastag tagmembers self parent base if inl inr case match force undefined fail not format read 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 locateme structures floorplan detect resonate density sniff chirp watch surveil heading blocked scan upload ishere isempty meet meetall whoami setname random run pure try print erase 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 "[-=!<>|&+*/^$:]"@@ -9,7 +9,7 @@ syn match Comment "//.*$" syn region MultilineComment start="/\*" end="\*/" syn match Brackets "[\[\]\(\)\{\}]"-syn match String "\".*\""+syn match String "\"\(\\\(['\"bfnrtav0-9]\|x[0-9a-fA-F]\)\|[^\\\"]\)*\"" syn match Number "\<[-]\=\d\+\>"  hi def link Keyword Statement
editors/vscode/syntaxes/swarm.tmLanguage.yaml view
@@ -32,6 +32,7 @@     patterns:       - include: '#keyword'       - include: '#require'+      - include: '#stock'       - include: '#operator'       - include: '#lambda'       - include: '#chain'@@ -46,10 +47,13 @@       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(waypoint|waypoints|hastag|tagmembers|self|parent|base|if|inl|inr|case|match|force|undefined|fail|not|format|read|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|structures|floorplan|detect|resonate|density|sniff|chirp|watch|surveil|heading|blocked|scan|upload|ishere|isempty|meet|meetall|whoami|setname|random|run|pure|try|print|erase|swap|atomic|instant|installkeyhandler|teleport|warp|as|robotnamed|robotnumbered|knows)\b       require:         name: keyword.control.require         match: \b(require)\b+      stock:+        name: keyword.control.stock+        match: \b(stock)\b       lambda:         name: keyword.operator.lambda         match: \\(\w+)\.
example/BFS-clear.sw view
@@ -13,11 +13,11 @@ end; def getX : Cmd Int =   pos <- whereami;-  return (fst pos);+  pure (match pos \x. \_. x); end; def getY : Cmd Int =   pos <- whereami;-  return (snd pos);+  pure (match pos \_. \y. y); end; def gotoX : Int -> Cmd Unit = \tgt.   cur <- getX;@@ -47,7 +47,7 @@      move;      b <- isHere "tree";      if b-       { build c; return () }+       { build c; pure () }        {};      turn back;      move
example/cat.sw view
@@ -6,7 +6,7 @@   \n. \c. if (n == 0) {} {c ; repeat (n-1) c} in let randdir : Cmd Dir =   d <- random 4;-  return (+  pure (     if (d == 0) {north}     {if (d == 1) {east}     {if (d == 2) {south} {west}}})
example/list.sw view
@@ -1,3 +1,4 @@+ /*******************************************************************/ /*                       LIST ENCODING IN INT                      */ /*                                                                 */@@ -8,37 +9,39 @@ /*                                                                 */ /* For examples of usage see the unit tests in testLIST function.  */ /*                                                                 */-/*******************************************************************/+/* NOTE THAT THIS IS NOT EFFICIENT OR ERGONIMIC!!! YOU SHOULD USE: */+tydef NormalListType a = rec l. Unit + (a * l) end ++/*                                                                 */+/* This code was written before swarm had 'format' or 'rec', but   */+/* it still serves as an example of pure swarm code with tests.    */+/*******************************************************************/+// // Definitions: // - MAIN: nil (Haskell []), cons (Haskell (:)), head, tail // - BONUS: headTail, index, for, for_each, for_each_i // - ARITH: len, mod, shiftL, shiftR, shiftLH, shiftRH // - HELPERS: consP, getLenPart, setLenPart, to1numA, getLenA // - TESTS: assert, testLIST, testLIST_BIG, testLIST_ALL-+// /*******************************************************************/ /*                              TYPE                               */ /*******************************************************************/- // Type of list of ints - the inner ints can themselves be lists, // so *any* type can be encoded inside. // // It is the callers responsibility to make sure a program using this // "type" is type safe. Notably 2 == [0] != [] == 0 but [] !! x == 0.-//-// TODO: once #153 is resolved, add types to definitions-//-// type ListI = Int+tydef ListI = Int end + /*******************************************************************/ /*                             LAYOUT                              */ /*******************************************************************/- // The length of a number is kept in the header and split into 7bit // chunks each prefixed by 1bit that marks if the byte is last in // the header (0=YES).- /* EXAMPLE - [short_x,long_y] - concretly e.g. [42, 2^(2^7)]  0   < len short_x < 2^7@@ -50,265 +53,266 @@ ^^^^^^^^^^^^       ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^   head                         tail */- /*******************************************************************/ /*                         ARITH PRIMITIVES                        */ /*******************************************************************/- // bitlength of a number (shifting by one)-def naive_len : Int -> Int = \i.-  if (i == 0) {0} {1 + naive_len (i/2)}+def naive_len: Int -> Int -> Int +  = \acc. \i.+  if (i == 0) {acc} {naive_len (1 + acc) (i / 2)} end + // modulus function (%)-def mod : Int -> Int -> Int = \i.\m.-  i - m * (i / m)-end+def mod: Int -> Int -> Int = \i. \m. i - m * (i / m) end + // f X Y = Y * 2^(-X)-def shiftL : Int -> Int -> Int = \s.\i.-  i / 2^s-end+def shiftL: Int -> Int -> Int = \s. \i. i / 2 ^ s end + // f X Y = Y * 2^(X)-def shiftR : Int -> Int -> Int = \s.\i.-  i * 2^s-end+def shiftR: Int -> Int -> Int = \s. \i. i * 2 ^ s end + // shift by (8bit) bytes-def shiftLH : Int -> Int -> Int = \s. shiftL (s*8) end-def shiftRH : Int -> Int -> Int = \s. shiftR (s*8) end+def shiftLH: Int -> Int -> Int = \s. shiftL (s * 8) end -// bitlength of a number (shifting by 64)-def len : Int -> Int = \i.-  let next = i / 2^64 in-  if (next == 0) {naive_len i} {64 + len next}+def shiftRH: Int -> Int -> Int = \s. shiftR (s * 8) end+++// bitlength of a number using an accumulator (shifting by 64)+def len_accum: Int -> Int -> Int +  = \acc. \i.+  let next = i / 2 ^ 64 in+  if (next == 0) {naive_len acc i} {len_accum (acc + 64) next} end ++// bitlength of a number (uses an accumulator and shifts by 64 bits)+def len: Int -> Int = len_accum 0 end++ /*******************************************************************/ /*                       helper functions                          */ /*******************************************************************/+def getLenPart: Int -> Int = \i. mod (i / 2) (2 ^ 7) end -def getLenPart : Int -> Int = \i. mod (i/2) (2^7) end-def setLenPart : Int -> Int = \i. 2 * (mod i (2^7)) end+def setLenPart: Int -> Int = \i. 2 * mod i (2 ^ 7) end + // Split length into 7-bit parts and prefix all but last with 1-def to1numA : Int -> Int * Int = \i.+def to1numA: Int -> (Int * Int) +  = \i.   let nextPart = shiftL 7 i in-  if (nextPart == 0)-    { ((2 * i), 1) } /* last part */-    { let p = to1numA nextPart in-      ( 1 /* header isEnd bit */ + setLenPart i + shiftRH 1 (fst p)-      , 1 + snd p-      )-    }+  if (nextPart == 0) {++    // last part+    (2 * i, 1)+  } {+    let p = to1numA nextPart in+    match p \a. \b.+    (1 /* header isEnd bit */ + setLenPart i + shiftRH 1 a, 1 + b)+  } end + // Get bitlength of the first number in the list // and also the list starting at the number itself-//-// getLenA : ListI -> Int * Int-def getLenA = \xs.+def getLenA: ListI -> (Int * Int) +  = \xs.   let isEnd = 0 == mod xs 2 in   let l = getLenPart xs in   let nextPart = shiftLH 1 xs in-  if isEnd-    { (l, nextPart) }-    { let p = getLenA nextPart in-      (l + shiftR 7 (fst p), snd p)-    }+  if isEnd {(l, nextPart)} {+    let p = getLenA nextPart in+    match p \bits. \lst.+    (l + shiftR 7 bits, lst)+  } end + /*******************************************************************/ /*                         LIST FUNCTIONS                          */ /*******************************************************************/--// headTail : ListI -> {Int} * {ListI}-def headTail = \xs.+def headTail: ListI -> (Int * ListI) +  = \xs.   let sign = mod xs 2 in   let ns = xs / 2 in   let p = getLenA ns in-  ( { let x = mod (snd p) $ 2 ^ fst p in-      if (sign == 0) {x} {-x}-    }-  , { shiftL (fst p) (snd p) }-  )+  match p \bits. \lst.+  ( let x = mod lst $ 2 ^ bits in if (sign == 0) {x} {-x}+  , shiftL bits lst ) end -// head : ListI -> Int-def head : Int -> Int = \xs.-  force $ fst $ headTail xs+def head: ListI -> Int +  = \xs.+  let sign = mod xs 2 in+  let ns = xs / 2 in+  let p = getLenA ns in+  match p \bits. \lst.+  let x = mod lst $ 2 ^ bits in if (sign == 0) {x} {-x} end -// tail : ListI -> ListI-def tail = \xs.-  force $ snd $ headTail xs+def tail: ListI -> ListI +  = \xs.+  let sign = mod xs 2 in+  let ns = xs / 2 in+  let p = getLenA ns in+  match p \bits. \lst.+  shiftL bits lst end -// nil : ListI-def nil = 0 end+def nil: ListI = 0 end + // Add non-negative number to beginning of list (cons adds the sign)-// consP : nat -> ListI -> Int-def consP = \x.\xs.-  if (x == 0)-    { 2 /* header says one bit length */ + shiftR (8+1) xs}-    { let l = len x in-      let pl = to1numA l in-      (fst pl + shiftRH (snd pl) (x + shiftR l xs))-    }+def consP: Int -> ListI -> Int +  = \x. \xs.+  if (x == 0) {2 /* header says one bit length */ + shiftR (8 + 1) xs} {+    let l = len x in+    let pl = to1numA l in+    match pl \a. \b.+    a + shiftRH b (x + shiftR l xs)+  } end + // Add integer to the beginning of the list-// consP : Int -> ListI -> ListI-def cons = \x.\xs.-  if (x >= 0)-    {     2 * consP   x  xs }-    { 1 + 2 * consP (-x) xs }+def cons: Int -> ListI -> ListI +  = \x. \xs.+  if (x >= 0) {2 * consP x xs} {1 + 2 * consP (-x) xs} end   /*******************************************************************/ /*                       MORE LIST FUNCTIONS                       */ /*******************************************************************/--// index : Int -> ListI -> Int-def index = \i.\xs.-  if (i <= 0)-    {head xs}-    {index (i-1) (tail xs)}+def index: Int -> ListI -> Int +  = \i. \xs.+  if (i <= 0) {head xs} {index (i - 1) (tail xs)} end -def for : Int -> Int -> (Int -> Cmd a) -> Cmd Unit = \s.\e.\act.-  if (s == e) {}-  {act s; for (s+1) e act}+def for: ∀ a. Int -> Int -> (Int -> Cmd a) -> Cmd Unit +  = \s. \e. \act.+  if (s == e) {} {act s; for (s + 1) e act} end -// for_each_i : Int -> ListI Int -> (Int * Int -> Cmd a) -> Cmd Unit-def for_each_i = \i.\xs.\act.-  if (xs == nil) {}-  { let ht = headTail xs-    in act i (force $ fst ht); for_each_i (i+1) (force $ snd ht) act+def for_each_i: Int -> ListI -> (Int -> Int -> Cmd Unit) -> Cmd Unit +  = \i. \xs. \act.+  if (xs == nil) {} {+    let ht = headTail xs in+    match ht \hd. \tl.+    act i hd; for_each_i (i + 1) tl act   } end -// for_each : ListI Int -> (Int -> Cmd a) -> Cmd Unit-def for_each = \xs.\act.+def for_each: ListI -> (Int -> Cmd Unit) -> Cmd Unit +  = \xs. \act.   for_each_i 0 xs (\i. act) end + /*******************************************************************/ /*                           UNIT TESTS                            */ /*******************************************************************/+def assert = \b. \m. if b {} {log "FAIL:"; fail m} end -// TODO: show values when #248 is implemented-def assert = \b.\m.-  if b {} {log "FAIL:"; fail m}+def assert_eq +  = \exp. \act. \m.+  if (exp == act) {} {+    log ("FAIL: expected " ++ format exp ++ " actual " ++ format act);+    fail m+  } end  def testLIST =   log "STARTING TESTS OF LIST:";-   log "check [0]";   let l0 = cons 0 nil in-  assert (l0 == 4)                   "[0] ~ 4";-  assert (head l0 == 0)              "head [0] == 0";-  assert (tail l0 == nil)            "tail [0] == []";-+  assert_eq l0 4 "[0] ~ 4";+  assert_eq (head l0) 0 "head [0] == 0";+  assert_eq (tail l0) nil "tail [0] == []";   log "check [1]";   let l1 = cons 1 nil in-  assert (l1 == 516)                 "[1] ~ 516";-  assert (head l1 == 1)              "head [1] == 1";-  assert (tail l1 == nil)            "tail [1] == []";-+  assert_eq l1 516 "[1] ~ 516";+  assert_eq (head l1) 1 "head [1] == 1";+  assert_eq (tail l1) nil "tail [1] == []";   log "check [-1]";   let ln1 = cons (-1) nil in-  assert (ln1 == 517)                "[-1] ~ 517";-  assert (head ln1 == -1)            "head [-1] == -1";-  assert (tail ln1 == nil)           "tail [-1] == []";-+  assert_eq ln1 517 "[-1] ~ 517";+  assert_eq (head ln1) (-1) "head [-1] == -1";+  assert_eq (tail ln1) nil "tail [-1] == []";   log "check [42]";   let l42 = cons 42 nil in-  assert (l42 == 21528)              "[42] ~ 21528";-  assert (head l42 == 42)            "head [42] == 42";-  assert (tail l42 == nil)           "tail [42] == []";-+  assert_eq l42 21528 "[42] ~ 21528";+  assert_eq (head l42) 42 "head [42] == 42";+  assert_eq (tail l42) nil "tail [42] == []";   log "check [499672]";   let l499672 = cons 499672 nil in-  assert (l499672 == 255832140)      "[499672] ~ 255832140";-  assert (head l499672 == 499672)    "head [499672] == 499672";-  assert (tail l499672 == nil)       "tail [499672] == []";-+  assert_eq l499672 255832140 "[499672] ~ 255832140";+  assert_eq (head l499672) 499672 "head [499672] == 499672";+  assert_eq (tail l499672) nil "tail [499672] == []";   log "check [1,0]";   let l1_0 = cons 1 l0 in-  assert (l1_0 == 4612)              "[1,0] ~ 4612";-  assert (head l1_0 == 1)            "head [1,0] == 1";-  assert (tail l1_0 == l0)           "tail [1,0] == [0]";-+  assert_eq l1_0 4612 "[1,0] ~ 4612";+  assert_eq (head l1_0) 1 "head [1,0] == 1";+  assert_eq (tail l1_0) l0 "tail [1,0] == [0]";   log "check [11,1,0]";   let l11_1_0 = cons 11 l1_0 in-  assert (head l11_1_0 == 11)        "head [11,1,0] == 11";-  assert (tail l11_1_0 == l1_0)      "tail [11,1,0] == [1,0]";-+  assert_eq (head l11_1_0) 11 "head [11,1,0] == 11";+  assert_eq (tail l11_1_0) l1_0 "tail [11,1,0] == [1,0]";   log "check [0..9]";-  let l0__9 = cons 0 $ cons 1 $ cons 2 $ cons 3 $ cons 4 $ cons 5 $ cons 6 $ cons 7 $ cons 8 $ cons 9 nil in-  assert (head l0__9 == 0)           "head [0..9] == 0";--  log "check indices";-  assert (index 0 l0__9 == 0)        "[0..9] !! 0 == 0";-  assert (index 9 l0__9 == 9)        "[0..9] !! 9 == 9";--  // TODO: log the number of iteration once #248 is implemented--  log "check for";-  for 0 9 (\i.-    assert (index i l0__9 == i)      "[0..9] - every index I has value I"+  let l0__9 =+    cons 0 $ cons 1 $ cons 2 $ cons 3 $ cons 4 $ cons 5 $ cons 6 $ cons 7 $ cons 8 $ cons 9 nil in+  assert_eq (head l0__9) 0 "head [0..9] == 0";+  log "- check indices";+  assert_eq (index 0 l0__9) 0 "[0..9] !! 0 == 0";+  assert_eq (index 9 l0__9) 9 "[0..9] !! 9 == 9";+  log "check for + index";+  for 0 9 (+    \i. log ("- at index " ++ format i);+    assert_eq (index i l0__9) i "[0..9] - every index I has value I"   );-   log "check for_each";-  for_each l0__9 (\x.-    assert (x < 10)                  "[0..9] - every value X < 10"+  for_each l0__9 (+    \x. log ("- at value " ++ format x);+    assert (x < 10) "[0..9] - every value X < 10"   );-   log "check for_each_i";-  for_each_i 0 l0__9 (\i.\x.-    assert (i == x)                  "[0..9] - I == X for every value X at index I"+  for_each_i 0 l0__9 (+    \i. \x. log ("- at index " ++ format i);+    assert_eq i x "[0..9] - I == X for every value X at index I"   );-   log "OK - ALL TEST PASSED\a" end + // This tests uses VERY LONG lists of size up to 2097332 bits. // TIP: increase the game speed (ticks/s) when you run this test. def testLIST_BIG =   log "STARTING TESTS OF BIG LISTS:";-   log "check [2^(2^7)] aka [big]";-  let big = 2^2^7 in-  assert (len big == 129)            "len (2^2^7) == 2^7+1";-  assert (to1numA 129 == (515,2))    "to1numA: 129 == 1000_0001 --> 515 == [0000 001 0] [0000 001 1]";-  assert (getLenA 515 == (129,nil))  "getLenA: 515 --> 129";+  let big = 2 ^ 2 ^ 7 in+  assert_eq (len big) 129 "len (2^2^7) == 2^7+1";+  assert_eq (to1numA 129) ( 515+  , 2 ) "to1numA: 129 == 1000_0001 --> 515 == [0000 001 0] [0000 001 1]";+  assert_eq (getLenA 515) (129, nil) "getLenA: 515 --> 129";   let ibig = 2 * (shiftR 16 big + 515) in   let lbig = cons big nil in-  assert (lbig == ibig)              "[big] ~ 2 * ((big * 2^(2*8)) + 515)";-  assert (head lbig == big)          "head [big] == big";-  assert (tail lbig == nil)          "tail [big] == []";-+  assert_eq lbig ibig "[big] ~ 2 * ((big * 2^(2*8)) + 515)";+  assert_eq (head lbig) big "head [big] == big";+  assert_eq (tail lbig) nil "tail [big] == []";   log "check [2^(2^21)] aka [bigger]";-  let bigger = 2^(2^21) in+  let bigger = 2 ^ 2 ^ 21 in   let lbigger = cons bigger nil in-  assert (head lbigger == bigger)    "head [bigger] == bigger";-  assert (tail lbigger == nil)       "tail [bigger] == []";-+  assert_eq (head lbigger) bigger "head [bigger] == bigger";+  assert_eq (tail lbigger) nil "tail [bigger] == []";   log "check [2^(2^21),2^(2^7)] aka [bigger,big]";   let lbiggest = cons bigger lbig in-  assert (head lbiggest == bigger)  "head [bigger,big] == bigger";-  assert (tail lbiggest == lbig)    "tail [bigger,big] == [big]";--  log "OK - ALL TEST PASSED";+  assert_eq (head lbiggest) bigger "head [bigger,big] == bigger";+  assert_eq (tail lbiggest) lbig "tail [bigger,big] == [big]";+  log "OK - ALL TEST PASSED" end -def testLIST_ALL =-  testLIST;-  testLIST_BIG;-end+def testLIST_ALL = testLIST; testLIST_BIG end
example/multi-key-handler.sw view
@@ -2,10 +2,10 @@ // handlers that process multi-key sequences.  def cons : a * b -> (a -> b) -> (a -> b) = \p. \k. \a.-  if (a == fst p) {snd p} {k a}+  match p \x. \y. if (a == x) {y} {k a} end -def nil : a -> Cmd Unit = \a. return () end+def nil : a -> Cmd Unit = \a. pure () end  // The delay around the first argument is necessary to prevent // infinite recursion
example/pilotmode.sw view
@@ -1,8 +1,8 @@ def cons : a * b -> (a -> b) -> (a -> b) = \p. \k. \a.-  if (a == fst p) {snd p} {k a}+  match p \x. \y. if (a == x) {y} {k a} end -def nil : a -> Cmd Unit = \a. return () end+def nil : a -> Cmd Unit = \a. pure () end  // Suitable to use as e.g. //   installKeyHandler "(S-)←↓↑→ [Del] [g]rab [h]arvest [d]rill [s]can [b]locked [u]pload" pilot@@ -18,8 +18,8 @@   cons (key "Del",     selfdestruct) $   cons (key "g",       res <- grab; log res) $   cons (key "h",       res <- harvest; log res) $-  cons (key "d",       res <- drill forward; case res (\_. return ()) log) $-  cons (key "s",       res <- scan forward; case res (\_. return ()) log) $+  cons (key "d",       res <- drill forward; case res (\_. pure ()) log) $+  cons (key "s",       res <- scan forward; case res (\_. pure ()) log) $   cons (key "b",       b <- blocked; if b {log "blocked"} {log "not blocked"}) $   cons (key "u",       upload base) $   nil
example/rectypes.sw view
@@ -6,6 +6,23 @@ // (rec l. Unit + Int * l) = (rec q. Unit + Int * q)  ////////////////////////////////////////////////////////////+// Utilities+////////////////////////////////////////////////////////////++// Flipped versions of match and case come in handy for+// writing functions where we want to immediately match or case on+// the argument.  e.g. instead of  `\p. match p \x. \y. ...` we can+// write `λmatch \x. \y. ...`++def λmatch : (a -> b -> c) -> (a * b) -> c =+  \f. \p. match p f+end++def λcase : (a -> c) -> (b -> c) -> (a + b) -> c =+  \f. \g. \s. case s f g+end++//////////////////////////////////////////////////////////// // Lists //////////////////////////////////////////////////////////// @@ -14,10 +31,9 @@ def nil : List a = inl () end def cons : a -> List a -> List a = \x. \l. inr (x, l) end -def foldr : (a -> b -> b) -> b -> List a -> b = \f. \z. \xs.-  case xs-    (\_. z)-    (\c. f (fst c) (foldr f z (snd c)))+def foldr : (a -> b -> b) -> b -> List a -> b = \f. \z. λcase+  (\_. z)+  (λmatch \x. \xs. f x (foldr f z xs)) end  def map : (a -> b) -> List a -> List b = \f.@@ -59,11 +75,11 @@ end  def foldBTree : (b -> c) -> (c -> a -> c -> c) -> BTree a b -> c =-  \lf. \br. \t.-    case t-      lf-      // fst p, fst (snd p), snd (snd p) is annoying; see #1893-      (\p. br (foldBTree lf br (fst p)) (fst (snd p)) (foldBTree lf br (snd (snd p))))+  \lf. \br. λcase+    lf+    (λmatch \l. λmatch \x. \r.+      br (foldBTree lf br l) x (foldBTree lf br r)+    ) end  def max : Int -> Int -> Int = \a. \b. if (a > b) {a} {b} end@@ -81,8 +97,8 @@ // but we do it this way just to show off nested rec tydef Rose a = rec r. a * (rec l. Unit + r * l) end -def foldRose : (a -> List b -> b) -> Rose a -> b = \f. \r.-  f (fst r) (map (foldRose f) (snd r))+def foldRose : (a -> List b -> b) -> Rose a -> b = \f. λmatch \a. \ts.+  f a (map (foldRose f) ts) end  def flatten : Rose a -> List a =
+ example/recursive-containers.sw view
@@ -0,0 +1,801 @@+/*******************************************************************/+/*                           CONTAINERS                            */+/*******************************************************************/+// This file has an example implementation of lists, sets and maps+// (a.k.a dictionaries) using recursive types.+//+// The implementation uses a Red-Black tree balanced binary tree+// with projection (k -> a) to get sets and dictionaries (compare+// only first element of tuple). It is based on Haskell code in:+// https://abhiroop.github.io/Haskell-Red-Black-Tree/++// Flipped versions of match and case come in handy for+// writing functions where we want to immediately match or case on+// the argument.  e.g. instead of  `\p. match p \x. \y. ...` we can+// write `λmatch \x. \y. ...`++def λmatch : (a -> b -> c) -> (a * b) -> c =+  \f. \p. match p f+end++def λcase : (a -> c) -> (b -> c) -> (a + b) -> c =+  \f. \g. \s. case s f g+end++/*******************************************************************/+/*                    (TYPE) DECLARATIONS                          */+/*******************************************************************/++tydef Maybe a = Unit + a end++tydef List a = rec l. Maybe (a * l) end++tydef RBTree k = rec b. Maybe [red: Bool, k: k, l: b, r: b] end++tydef ISet s a =+  [ empty: s+  , insert: a -> s -> s+  , delete: a -> s -> s+  , contains: a -> s -> Bool+  , from_list: List a -> s+  , pretty: s -> Text+  ]+end++def undefined_set : any -> ISet any s =\empty.+    [empty=empty, insert=\x.undefined, delete=\x.undefined, contains=\x.undefined, from_list=\x.undefined, pretty=\x.undefined]+end++tydef IDict d k v =+  [ empty: d+  , insert: k -> v -> d -> d+  , delete: k -> d -> d+  , get: k -> d -> Maybe v+  , contains: k -> d -> Bool+  , pretty: d -> Text+  ]+end++def undefined_dict : any -> IDict any k v =\empty.+    [empty=empty, insert=\x.undefined, delete=\x.undefined, get=\x.undefined, contains=\x.undefined, pretty=\x.undefined]+end++tydef FlatSet a = List a end+def flat_set : ISet (FlatSet a) a = undefined_set (inl ()) end++tydef FlatDict k v = List (k * v) end+def flat_dict : IDict (FlatDict k v) k v = undefined_dict (inl ()) end++tydef Set k = RBTree k end+def tree_set : ISet (Set a) a = undefined_set (inl ()) end++tydef Dict k v = RBTree (k * v) end+def tree_dict : IDict (Dict k v) k v = undefined_dict (inl ()) end++/*******************************************************************/+/*                              MAYBE                              */+/*******************************************************************/++def mmap : (a -> b) -> Maybe a -> Maybe b = \f. λcase (\_. inl ()) (\a. inr (f a)) end++/*******************************************************************/+/*                              LISTS                              */+/*******************************************************************/++def emptyL : List a = inl () end+def cons : a -> List a -> List a = \a.\l. inr (a, l) end+def pureL : a -> List a = \a. cons a emptyL end++def foldr : (a -> b -> b) -> b -> List a -> b = \f. \z. λcase+  (\_. z)+  (λmatch \hd. \tl. f hd (foldr f z tl))+end++def foldl : (b -> a -> b) -> b -> List a -> b = \f. \z. λcase+  (\_. z)+  (λmatch \hd. \tl. (foldl f (f z hd) tl))+end++def flip : (a -> b -> c) -> (b -> a -> c) = \f. (\b.\a.f a b) end++def map : (a -> b) -> List a -> List b = \f.+  foldr (\y. cons (f y)) emptyL+end++def appendL : List a -> List a -> List a = \xs. \ys.+  foldr cons ys xs+end++def lengthL : List a -> Int = foldl (\acc.\_. acc + 1) 0 end++def safeGetL : Int -> List a -> Maybe a = \i. λcase+  (\_. inl ())+  (λmatch \hd. \tl. if (i <= 0) {inr hd} {safeGetL (i - 1) tl})+end++def getL : Int -> List a -> a = \i.\l.+  case (safeGetL i l) (\_. fail $ "INDEX " ++ format i ++ " OUT OF BOUNDS!") (\a. a)+end++def formatL : List a -> Text = \l.+ let f : List a -> Text = λcase (\_. "]") (λmatch \hd. \tl. ", " ++ format hd ++ f tl)+ in case l (\_. "[]") (λmatch \hd. \tl. "[" ++ format hd ++ f tl)+end++/*******************************************************************/+/*                          ORDERED LISTS                          */+/*******************************************************************/++// get from ordered list+def getKeyL : (a -> k) -> k -> List a -> Maybe a = \p. \x. λcase+  (\_. inl ())+  (λmatch \hd. \tl.+    let nx = p hd in+    if (nx < x) {+      getKeyL p x tl+    } {+      if (nx > x) {+        inl ()+      } {+        inr hd+      }+    }+  )+end++def containsKeyL : (a -> k) -> k -> List a -> Bool = \p.\x.\l.+  case (getKeyL p x l) (\_. false) (\_. true)+end++// insert into ordered list - replaces elements, like set+def insertKeyL : (a -> k) -> a -> List a -> List a = \p.\y.\l. case l+  (\_. pureL y)+  (λmatch \hd. \tl.+    let nx = p hd in+    let x = p y in+    if (nx == x) {+      inr (y, tl)+    } {+      if (nx > x) {+        cons y l+      } {+        cons hd (insertKeyL p y tl)+      }+    }+  )+end++// delete in ordered list+def deleteKeyL : (a -> k) -> k -> List a -> List a = \p.\x. \l. case l+  (\_. emptyL)+  (λmatch \hd. \tl.+    let nx = p hd in+    if (nx == x) {+      tl+    } {+      if (nx > x) {+        l+      } {+        cons hd (deleteKeyL p x tl)+      }+    }+  )+end++tydef FlatSet a = List a end++def flat_set : ISet (FlatSet a) a =+  [ empty=emptyL+  , insert=insertKeyL (\x.x)+  , delete=deleteKeyL (\x.x)+  , contains=containsKeyL (\x.x)+  , from_list=foldl (flip $ insertKeyL (\x.x)) emptyL+  , pretty=formatL+  ]+end++tydef FlatDict k v = List (k * v) end++def fst = λmatch \a. \_. a end+def snd = λmatch \_. \b. b end++def flat_dict : IDict (FlatDict k v) k v =+  [ empty=emptyL+  , insert=\k.\v. insertKeyL fst (k,v)+  , delete=deleteKeyL fst+  , get=\k.\d. mmap snd (getKeyL fst k d)+  , contains=containsKeyL fst+  , pretty=\d.+    let p : (k * v) -> Text = λmatch \k. \v. format k ++ ": " ++ format v in+    let f : List (k * v) -> Text = λcase (\_. "}") (λmatch \hd. \tl. ", " ++ p hd ++ f tl)+    in case d (\_. "{}") (λmatch \hd. \tl. "{" ++ p hd ++ f tl)+  ]+end++/*******************************************************************/+/*                         RED BLACK TREE                          */+/*******************************************************************/+++// equirecursive types allow us to get the node type without mutual recursion+tydef RBNode k = rec n. [red: Bool, k: k, l: Maybe n, r: Maybe n] end++def emptyT : RBTree k = inl () end++def getT : (k -> a) -> a -> RBTree k -> Maybe k = \p. \x. \t. case t+  (\_. inl ())+  (\n .+    let nx = p n.k in+    if (x < nx) {+        getT p x n.l+    } {+      if (x > nx) {+          getT p x n.r+      } {+        inr n.k+      }+    }+  )+end++def containsT : (k -> a) -> a -> RBTree k -> Bool = \p.\x.\t. getT p x t != inl () end++def inorder : RBTree k -> List k = \t. case t+  (\_. inl ())+  (\n. appendL (inorder n.l) (appendL (pureL n.k) $ inorder n.r))+end++def formatT : RBTree k -> Text = \t. case t+  (\_. "N")+  (\n.+    "(T "+    ++ if n.red {"R "} {"B "}+    ++ formatT n.l ++ " " ++ format n.k ++ " " ++ formatT n.r ++ ")"+  )+end++def indent_ = \c.\i. if (i <= 0) {" "} {c ++ indent_ c (i - 1)} end+def indent = indent_ " " end++def debugT : RBTree k -> Cmd Unit =+  let d : Text -> Text -> Text -> RBTree k -> Cmd Unit = \i.\li.\ri.\t. case t+    (\_. log $ i ++ "+ N")+    (\n.+      d (i ++ li) "  " "| " n.l;+      log $ i ++ "+ " ++ if n.red {"R "} {"B "} ++ format n.k;+      d (i ++ ri) "| " "  " n.r;+    )+  in d "" "" ""+end++/*+balance B (T R (T R a x0 b) x1 c) x2 d = T R (T B a x0 b) x1 (T B c x2 d) -- case 1: LL red+balance B (T R a x0 (T R b x1 c)) x2 d = T R (T B a x0 b) x1 (T B c x2 d) -- case 2: LR red+balance B a x0 (T R (T R b x1 c) x2 d) = T R (T B a x0 b) x1 (T B c x2 d) -- case 3: RL red+balance B a x0 (T R b x1 (T R c x2 d)) = T R (T B a x0 b) x1 (T B c x2 d) -- case 4: RR red+balance color a x b = T color a x b -- case 5+*/+def balanceT : RBNode k -> RBTree k = \t.+  let balanced : [ a: RBTree k, x0: k, b: RBTree k,   x1: k,   c: RBTree k, x2: k, d: RBTree k] -> RBTree k+    = \v.+    inr [red=true, l=inr [red=false, l=v.a, k=v.x0, r=v.b], k=v.x1, r=inr [red=false, l=v.c, k=v.x2, r=v.d]]+  in let case5 : RBNode k -> RBTree k =+    inr  // just id - TODO: inline?+  in let balanceRR : RBNode k -> RBNode k -> RBTree k = \t.\rn.+    case rn.r (\_. case5 t) (\rrn.+      if rrn.red {+        balanced [a=t.l, x0=t.k, b=rn.l, x1=rn.k, c=rrn.l, x2=rrn.k, d=rrn.r]+      } {+        case5 t+      }+    )+  in let balanceRL : RBNode k -> RBNode k -> RBTree k = \t.\rn.+    case rn.l (\_. balanceRR t rn) (\rln.+      if rln.red {+        balanced [a=t.l, x0=t.k, b=rln.l, x1=rln.k, c=rln.r, x2=rn.k, d=rn.r]+      } {+        balanceRR t rn+      }+    )+  in let balanceR : RBNode k -> RBTree k = \t.+    case t.r (\_.+      case5 t+    ) (\lr.+      if lr.red {+        balanceRL t lr+      } {+        case5 t+      }+    )+  in let balanceLR : RBNode k -> RBNode k -> RBTree k = \t.\ln.+    case ln.r (\_. balanceR t) (\lrn.+      if lrn.red {+        balanced [a=ln.l, x0=ln.k, b=lrn.l, x1=lrn.k, c=lrn.r, x2=t.k, d=t.r]+      } {+        balanceR t+      }+    )+  in let balanceLL : RBNode k -> RBNode k -> RBTree k = \t.\ln.+    case ln.l (\_. balanceLR t ln) (\lln.+      if lln.red {+        balanced [a=lln.l, x0=lln.k, b=lln.r, x1=ln.k, c=ln.r, x2=t.k, d=t.r]+      } {+        balanceLR t ln+      }+    )+  in let balanceL : RBNode k -> RBTree k = \t.+    case t.l (\_.+      balanceR t+    ) (\ln.+      if ln.red {+        balanceLL t ln+      } {+        balanceR t+      }+    )+  in if t.red {+    case5 t+  } {+    balanceL t+  }+end++def insertT : (k -> a) -> k -> RBTree k -> RBTree k = \p.\x.\t.+  let ins : (k -> a) -> k -> RBTree k -> RBTree k =\p.\x.\t. case t+    (\_.+      inr [red=true, k=x, l=inl (), r=inl ()]+    )+    (\n.+      if (p x == p n.k) { inr [red=n.red, k=x, l=n.l, r=n.r] } {+        if (x < n.k) {+            balanceT [red=n.red, k=n.k, l=ins p x n.l, r=n.r]+        } {+            balanceT [red=n.red, k=n.k, l=n.l, r=ins p x n.r]+        }+      }+    )+  in let makeBlack : RBTree k -> RBTree k = \t. case t+    (\_. fail "makeBlack will always be called on nonempty")+    (\n. inr [red=false, k=n.k, l=n.l, r=n.r] )+  in makeBlack $ ins p x t+end++def deleteT : (k -> a) -> a -> RBTree k -> RBTree k = \p.\x.\t.+  // ------------------------------------------------------------------------------------------------------------+  tydef Del k a = (k -> a) -> a -> RBTree k -> RBTree k end+  // ------------------------------------------------------------------------------------------------------------+  let makeBlack : RBTree k -> RBTree k = \t.+    case t (\_. t) (\n. inr [red=false, k=n.k, l=n.l, r=n.r])+  in let makeRed : RBNode k -> RBTree k = \n.+    inr [red=true, k=n.k, l=n.l, r=n.r]+  // ------------------------------------------------------------------------------------------------------------+  /*+  balL (T B (T R t1 x t2) y t3) = T R (T B t1 x t2) y t3+  balL (T B t1 y (T B t2 z t3)) = balance' (T B t1 y (T R t2 z t3))+  balL (T B t1 y (T R (T B t2 u t3) z t4@(T B l value r)))+    = T R+      (T B t1 y t2)+      u+      (balance' (T B t3 z+        (T R l value r)))+  */+  in let balL : RBNode k -> RBTree k = \n.+    let balL2 : RBNode k -> RBNode k -> RBTree k = \n.\rn.+      case rn.l (\_. inr n) (\rln.+        if rln.red {inr n} {+          case rn.r (\_. inr n) (\rrn.+            if rrn.red {inr n} {+              inr [red=true,+                   l=inr [red=false, l=n.l, k=n.k, r=rln.l],+                   k=rln.k,+                   r=balanceT [red=false, l=rln.r, k=rn.k, r=inr [red=true, l=rrn.l, k=rrn.k, r=rrn.r]]]+            }+          )+        }+      )+    in let balL1 : RBNode k -> RBTree k = \n.+      case n.r (\_. inr n) (\rn.+        if rn.red {balL2 n rn} {balanceT [red=false, k=n.k, l=n.l, r=makeRed rn]}+      )+    in case n.l (\_. balL1 n) (\ln. if ln.red {inr [red=true, k=n.k, l=makeBlack n.l, r=n.r]} {balL1 n})+  // ------------------------------------------------------------------------------------------------------------+  /*+  balR (T B t1 y (T R t2 x t3)) = T R t1 y (T B t2 x t3)+  balR (T B (T B t1 z t2) y t3) = balance' (T B (T R t1 z t2) y t3)+  balR (T B+    ln@(T R+      lln@(T B lll llk llr)+      lk+      lrn@(T B lrl lrk lrr))+    k+    rn)+    =+    T R+      (balance' (T B (T R lll llk llr) lk lrl))+      lrk+      (T B lrr k rn)+  */+  in let balR : RBNode k -> RBTree k = \n.+    let balR2 : RBNode k -> RBNode k -> RBTree k = \n.\ln.+      case ln.l (\_. inr n) (\lln.+        if lln.red {inr n} {+          case ln.r (\_. inr n) (\lrn.+            if lrn.red {inr n} {+              inr [red=true,+                   l=balanceT [red=false, l=inr [red=true, l=lln.l, k=lln.k, r=lln.r], k=ln.k, r=lrn.l],+                   k=lrn.k,+                   r=inr [red=false, l=lrn.r, k=n.k, r=n.r]]+            }+          )+        }+      )+    in let balR1 : RBNode k -> RBTree k = \n.+      case n.l (\_. inr n) (\ln.+        if ln.red {balR2 n ln} {balanceT [red=false, k=n.k, l=makeRed ln, r=n.r]}+      )+    in case n.r (\_. balR1 n) (\rn. if rn.red {inr [red=true, k=n.k, l=n.l, r=makeBlack n.r]} {balR1 n})+  // ------------------------------------------------------------------------------------------------------------+  in let delL : Del k a -> (k -> a) -> a -> RBNode k -> RBTree k = \del.\p.\x.\n.+    let dl = [red=n.red, k=n.k, l=del p x n.l, r=n.r] in+    if n.red { inr dl } { balL dl }+  // ------------------------------------------------------------------------------------------------------------+  in let delR : Del k a -> (k -> a) -> a -> RBNode k -> RBTree k = \del.\p.\x.\n.+    let dr = [red=n.red, k=n.k, l=n.l, r=del p x n.r] in+    if n.red { inr dr } { balR dr }+  // ------------------------------------------------------------------------------------------------------------+  /*+  fuse E t = t+  fuse t E = t+  fuse t1@(T B _ _ _) (T R t3 y t4) = T R (fuse t1 t3) y t4+  fuse (T R t1 x t2) t3@(T B _ _ _) = T R t1 x (fuse t2 t3)+  fuse (T R t1 x t2) (T R t3 y t4)  =+    let s = fuse t2 t3+    in case s of+        (T R s1 z s2) -> (T R (T R t1 x s1) z (T R s2 y t4))+        (T B _ _ _)   -> (T R t1 x (T R s y t4))+  fuse (T B t1 x t2) (T B t3 y t4)  =+    let s = fuse t2 t3+    in case s of+        (T R s1 z s2) -> (T R (T B t1 x s1) z (T B s2 y t4))+        (T B s1 z s2) -> balL (T B t1 x (T B s y t4))+  */+  in let fuse: RBTree k -> RBTree k -> RBTree k = \l.\r.+    case l (\_. r) (\ln. case r (\_. l) (\rn.+      if ln.red {+        if rn.red {+          /* RED RED */+          let s = fuse ln.r rn.l in+          let b_case = {inr [red=true, l=ln.l, k=ln.k, r=inr [red=true, l=s, k=rn.k, r=rn.r]]} in+          case s (\_. force b_case) (\sn.+            if sn.red {+              inr [red=true, l=inr [red=true, l=ln.l, k=ln.k, r=sn.l], k=sn.k, r=inr [red=true, l=sn.r, k=rn.k, r=rn.r]]+            } {+              force b_case+            }+          )+        } {+          /* RED BLACK */+          inr [red=true, l=ln.l, k=ln.k, r=fuse ln.r (inr rn)]+        }+      } {+        if rn.red {+          /* BLACK RED */+          inr [red=true, l=fuse (inr ln) rn.l, k=rn.k, r=rn.r]+        } {+          /* BLACK BLACK */+          let s = fuse ln.r rn.l in+          let b_case = {balL [red=false, l=ln.l, k=ln.k, r=inr [red=false, l=s, k=rn.k, r=rn.r]]} in+          case s (\_. force b_case) (\sn.+            if sn.red {+              inr [red=true, l=inr [red=false, l=ln.l, k=ln.k, r=sn.l], k=sn.k, r=inr [red=false, l=sn.r, k=rn.k, r=rn.r]]+            } {+              force b_case+            }+          )+        }+      }+    ))+  // ------------------------------------------------------------------------------------------------------------+  in let del : (k -> a) -> a -> RBTree k -> RBTree k = \p.\x.\t.+    case t (\_.t) (\n.+      if (p n.k == x) {fuse n.l n.r} {+        if (x < p n.k) {delL del p x n} {delR del p x n}+      }+    )+  // ------------------------------------------------------------------------------------------------------------+  in makeBlack $ del p x t+end++/*******************************************************************/+/*                           DICTIONARY                            */+/*******************************************************************/++tydef Dict k v = RBTree (k * v) end++def tree_dict : IDict (Dict k v) k v =+ [ empty = emptyT+ , get  = \k.\d. mmap snd (getT fst k d)+ , contains = containsT fst+ , insert = \k.\v. insertT fst (k, v)+ , delete = \k. deleteT fst k+ , pretty = \d. flat_dict.pretty (inorder d)+ ]+end++/*******************************************************************/+/*                              SET                                */+/*******************************************************************/++tydef Set k = RBTree k end++def tree_set : ISet (Set a) a =+  [ empty=emptyT+  , insert=insertT (\x.x)+  , delete=deleteT (\x.x)+  , contains=containsT (\x.x)+  , from_list=foldl (flip $ insertT (\x.x)) emptyT+  , pretty=\s. formatL $ inorder s+  ]+end++/*******************************************************************/+/*                           UNIT TESTS                            */+/*******************************************************************/++def assert = \i. \b. \m. if b {log $ indent i ++ "OK: " ++ m} {log "FAIL:"; fail m} end++def assert_eq+  = \i. \exp. \act. \m.+  if (exp == act) {log $ indent i ++ "OK: " ++ m} {+    log (indent i ++ "FAIL: expected " ++ format exp ++ " actual " ++ format act);+    fail m+  }+end++def group = \i. \m. \tests.+  log $ indent i ++ "START " ++ m ++ ":";+  tests $ i + 1;+  pure ()+end++def test_empty: Int -> Cmd Unit = \i.+  let d = tree_dict in+  group i "EMPTY TESTS" (\i.+    assert_eq i (inl ()) (d.get 0 $ d.empty) "no element should be present in an empty tree";+    assert i (not $ d.contains 0 $ d.empty) "empty tree should not contain any elements";+  )+end++def test_insert_1235: ISet s Int -> Int -> Cmd Unit =\s.\i.+    let expected = cons 1 $ cons 2 $ cons 3 $ cons 5 emptyL in+    let actual = s.insert 2 $ s.insert 5 $ s.insert 1 $ s.insert 3 s.empty in+    assert_eq i (formatL expected) (formatL actual) "insertKeyL should insert in order";+    assert i (not $ s.contains 0 actual) "not contains 0 [1,2,3,5]";+    assert i (s.contains 1 actual) "contains 1 [1,2,3,5]";+    assert i (s.contains 2 actual) "contains 2 [1,2,3,5]";+    assert i (s.contains 3 actual) "contains 3 [1,2,3,5]";+    assert i (not $ s.contains 4 actual) "not contains 4 [1,2,3,5]";+    assert i (s.contains 5 actual) "contains 5 [1,2,3,5]";+    assert i (not $ s.contains 6 actual) "not contains 6 [1,2,3,5]";+end++def test_ordered_list : Int -> Cmd Unit = \i.+  let s = flat_set in+  group i "ORDERED LIST TESTS" (test_insert_1235 flat_set)+end++def test_insert: Int -> Cmd Unit = \i.+  let d = tree_dict in+  let s = tree_set in+  group i "INSERT TESTS" (\i.+    group i "test {0: 1}" (\i.+      let tree0 = d.insert 0 1 d.empty in+      assert i (d.empty != tree0) "nonempty tree should not be empty";+      assert_eq i (inr 1) (d.get 0 $ tree0) "one element should be present in a one element tree";+      assert i (d.contains 0 $ tree0) "one element tree should contain that elements";+      assert i (not $ d.contains 1 $ tree0) "one element tree should contain only that elements";+    );+    group i "test {0: 1, 2: 3}" (\i.+      let tree02 = d.insert 2 3 $ d.insert 0 1 d.empty in+      assert_eq i (inr 1) (d.get 0 $ tree02) "get 0 {0: 1, 2: 3} == 1";+      assert_eq i (inr 3) (d.get 2 $ tree02) "get 2 {0: 1, 2: 3} == 3";+    );+    group i "test {1,2,3,5}" (test_insert_1235 tree_set)+  );+end++def randomTestS: Int -> Set Int -> (Set Int -> Cmd a) -> Cmd (Set Int) = \i.\s.\test.+  if (i <= 0) {pure s} {+    x <- random 20;+    let ns = tree_set.insert x s in+    test ns;+    randomTestS (i - 1) ns test+  }+end++def delete_insert_prop: Int -> Set Int -> Cmd Unit = \i.\t.+  let s = tree_set in+  x <- random 20;+  let i_t = inorder t in+  let f_t = s.pretty t in+  if (not $ s.contains x t) {+    // log $ format x;+    assert_eq i+      (formatL i_t)+      (s.pretty $ s.delete x $ s.insert x t)+      (f_t ++ " == delete " ++ format x ++ " $ insert " ++ format x ++ " " ++ f_t)+  } { delete_insert_prop i t /* reroll */}+end++def delete_delete_prop: Int -> Set a -> Cmd Unit = \i.\t.+  let s = tree_set in+  let i_t = inorder t in+  ix <- random (lengthL i_t);+  let x = getL ix i_t in+  let ds = s.delete x t in+  let dds = s.delete x ds in+  let f_t = s.pretty t in+  let f_dx = "delete " ++ format x in+  assert_eq i (s.pretty ds) (s.pretty dds)+    (f_dx ++ f_t ++ " == " ++ f_dx ++ " $ " ++ f_dx ++ " " ++ f_t)+end++def test_delete: Int -> Cmd Unit = \i.+  group i "DELETE TESTS" (\i.+    randomTestS 15 tree_set.empty (\s.+      group i (tree_set.pretty s) (\i.+        delete_insert_prop i s;+        delete_delete_prop i s;+      )+    )+  )+end++def test_tree: Cmd Unit =+  group 0 "TREE TESTS" (\i.+    test_empty i;+    test_ordered_list i;+    test_insert i;+    test_delete i;+  );+  log "ALL TREE TESTS PASSED!"+end++/*******************************************************************/+/*                           BENCHMARKS                            */+/*******************************************************************/++def benchmark: Int -> s -> (s -> s) -> Cmd (Int * (Int * Int)) = \times.\s.\act.+  let min = \x.\y. if (x > y) {y} {x} in+  let max = \x.\y. if (x > y) {x} {y} in+  let runM: (Int * Maybe (Int * Int)) -> s -> Int -> Cmd (Int * Maybe (Int * Int)) = \acc.\s.\n.+    if (n <= 0) {+      pure acc+    } {+      t0 <- time;+      //log $ "START " ++ format t0;+      let ns = act s in+      t1 <- time;+      //log $ "END " ++ format t1;+      let t = t1 - t0 in+      //log $ format s ++ " " ++ format t ++ " ticks";+      match acc \acc1. \acc2.+      let lim = case acc2 (\_. (t, t)) (λmatch \l1. \l2. (min t l1, max t l2)) in+      runM ((acc1 + t), inr lim) ns (n - 1)+    } in+  //log "start run";+  res <- runM (0, inl ()) s times;+  //log "end run";+  match res \res1. \res2.+  let avg = res1 / times in+  let lim = case res2 (\_. fail "BENCHMARK NOT RUN") (\l.l) in+  pure (avg, lim)+end++def cmp_bench : Int -> Text -> (Int * (Int * Int)) -> Text -> (Int * (Int * Int)) -> Cmd Unit+ = \i.\base_name.\base_res.\new_name.\new_res.+  let formatLim = λmatch \a. \b. "(min " ++ format a ++ ", max " ++ format b ++ ")" in+  log $ indent i ++ "* " ++ base_name ++ ": "+    ++ format (fst base_res) ++ " ticks " ++ formatLim (snd base_res);++  let d = (fst new_res * 100) / fst base_res in+  let cmp = if (d > 100) {+     format (d - 100) ++ "% slower"+    } {+      format (100 - d) ++ "% faster"+    } in+  match new_res \res1. \res2.+  log $ indent i ++ "* " ++ new_name ++ ": "+    ++ format res1 ++ " ticks " ++ formatLim res2+    ++ " <- " ++ cmp;+end++// Get a list of random integers of given length and maximum element number+def gen_random_list: Int -> Int -> Cmd (List Int) =+  let gen = \acc.\n.\rlim.+    if (n <= 0) { pure acc } {+      x <- random rlim;+      gen (cons x acc) (n - 1) rlim+    }+  in gen emptyL+end++// Get a number of lists of random integers of given length and maximum element number+def gen_random_lists: Int -> Int -> Int -> Cmd (List (List Int)) = \m.\n.\rlim.+  let gen = \acc.\m.+    if (m <= 0) { pure acc } {+      l <- gen_random_list n rlim;+      gen (cons l acc) (m - 1)+    }+  in gen emptyL m+end+++def bench_insert = \i.+  // Use the given function to construct (Flat)Set from the head of provided list of lists and return the tail+  let set_from_first_list : (List a -> s) -> List (List a) -> List (List a) =\from_list.\lls.+    case lls+      (\_. lls)+      // The 'ns = from_list ls' binding is unused, but intentional:+      // we want to benchmark how long it takes.+      (λmatch \ls. \nlls. let ns = from_list ls in nlls)+  in++  group i "INSERT BENCHMARK" (\i.+    group i "INSERT 10" (\i.+      let n = 10 in+      let m = 5 in+      lls10 <- gen_random_lists m n (3 * n);+      flat_res <- benchmark m lls10 (set_from_first_list flat_set.from_list);+      tree_res <- benchmark m lls10 (set_from_first_list tree_set.from_list);+      cmp_bench i "flat set" flat_res "tree set" tree_res+    );+    group i "INSERT 100" (\i.+      let n = 100 in+      let m = 3 in+      lls100 <- gen_random_lists m n (3 * n);+      flat_res <- benchmark m lls100 (set_from_first_list flat_set.from_list);+      tree_res <- benchmark m lls100 (set_from_first_list tree_set.from_list);+      cmp_bench i "flat set" flat_res "tree set" tree_res+    )+  )+end++def bench_contains = \i.+  let contains_int : s -> (Int -> s -> Bool) -> Int -> Int = \s.\contains.\n.+    let _ = contains n s in n + 1+  in+  group i "CONTAINS BENCHMARK" (\i.+    group i "CONTAINS 10" (\i.+      let n = 10 in+      let m = 3 * n in+      ls10 <- gen_random_list n m;+      let fls = flat_set.from_list ls10 in+      flat_res <- benchmark m 0 (contains_int fls flat_set.contains);+      let tls = tree_set.from_list ls10 in+      tree_res <- benchmark m 0 (contains_int tls tree_set.contains);+      cmp_bench i "flat set" flat_res "tree set" tree_res+    );+    group i "CONTAINS 100" (\i.+      let n = 100 in+      let m = 3 * n in+      ls100 <- gen_random_list n m;+      //log $ formatL ls100;+      let fls = flat_set.from_list ls100 in+      //log $ formatL fls;+      flat_res <- benchmark m 0 (contains_int fls flat_set.contains);+      let tls = tree_set.from_list ls100 in+      //log $ formatS tls;+      tree_res <- benchmark m 0 (contains_int tls tree_set.contains);+      cmp_bench i "flat set" flat_res "tree set" tree_res+    )+  )+end++def benchmark_tree: Cmd Unit =+  group 0 "TREE BENCHMARKS" (\i.+    bench_insert i;+    bench_contains i;+  );+  log "ALL BENCHMARKS DONE!"+end
src/swarm-doc/Swarm/Doc/Command.hs view
@@ -12,7 +12,6 @@ import GHC.Generics (Generic) import Servant.Docs qualified as SD import Swarm.Doc.Util-import Swarm.Language.Pretty (unchainFun) import Swarm.Language.Syntax import Swarm.Language.Syntax.CommandMetadata import Swarm.Language.Typecheck (inferConst)@@ -63,7 +62,7 @@   cmdInfo = constInfo c   cmdEffects = effectInfo $ constDoc cmdInfo -  getArgs ((Forall _ t)) = unchainFun t+  getArgs = unchainFun . ptBody    rawArgs = getArgs $ inferConst c
src/swarm-doc/Swarm/Doc/Gen.hs view
@@ -15,41 +15,31 @@   -- ** Wiki pages   PageAddress (..), -  -- ** Recipe graph data-  RecipeGraphData (..),+  -- ** Recipe graph drawing   EdgeFilter (..),-  classicScenarioRecipeGraphData,-  ignoredEntities, ) where  import Control.Lens (view, (^.)) import Control.Monad (zipWithM, zipWithM_)+import Data.Aeson.Text (encodeToLazyText) import Data.Containers.ListUtils (nubOrd) import Data.Foldable (toList) import Data.List qualified as List import Data.List.Extra (enumerate)-import Data.Map.Lazy (Map, (!)) import Data.Map.Lazy qualified as Map import Data.Maybe (fromMaybe, mapMaybe) import Data.Set (Set) import Data.Set qualified as Set-import Data.Text (Text, unpack) import Data.Text qualified as T import Data.Text.IO qualified as T-import Data.Tuple (swap)+import Data.Text.Lazy.IO qualified as TL+import Swarm.Doc.Command (getCatalog) import Swarm.Doc.Keyword import Swarm.Doc.Pedagogy-import Swarm.Doc.Util import Swarm.Doc.Wiki.Cheatsheet-import Swarm.Game.Entity (Entity, EntityMap (entitiesByName), entityName, entityYields)-import Swarm.Game.Entity qualified as E-import Swarm.Game.Failure (simpleErrorHandle)-import Swarm.Game.Land-import Swarm.Game.Recipe (Recipe, recipeCatalysts, recipeInputs, recipeOutputs)-import Swarm.Game.Robot (Robot, equippedDevices, robotInventory)-import Swarm.Game.Scenario (GameStateInputs (..), ScenarioInputs (..), loadStandaloneScenario, scenarioLandscape)-import Swarm.Game.World.Gen (extractEntities)-import Swarm.Game.World.Typecheck (Some (..))+import Swarm.Game.Entity (Entity, entityName, entityYields)+import Swarm.Game.Recipe (recipeCatalysts, recipeInputs, recipeOutputs)+import Swarm.Game.Recipe.Graph qualified as RG import Swarm.Language.Key (specialKeyNames) import Swarm.Util (both) import Text.Dot (Dot, NodeId, (.->.))@@ -73,6 +63,8 @@   SpecialKeyNames :: GenerateDocs   -- | Cheat sheets for inclusion on the Swarm wiki.   CheatSheet :: PageAddress -> SheetType -> GenerateDocs+  -- | JSON representation of commands metadata matrix+  CommandsData :: GenerateDocs   -- | List command introductions by tutorial   TutorialCoverage :: GenerateDocs   deriving (Eq, Show)@@ -94,6 +86,7 @@         mapM_ editorGen enumerate   SpecialKeyNames -> generateSpecialKeyNames   CheatSheet address s -> makeWikiPage address s+  CommandsData -> TL.putStrLn $ encodeToLazyText getCatalog   TutorialCoverage -> renderTutorialProgression >>= putStrLn . T.unpack  -- ----------------------------------------------------------------------------@@ -143,7 +136,7 @@  generateRecipe :: EdgeFilter -> IO String generateRecipe ef = do-  graphData <- classicScenarioRecipeGraphData+  graphData <- RG.classicScenarioRecipeGraph   return . Dot.showDot $ recipesToDot graphData ef  data EdgeFilter = NoFilter | FilterForward | FilterNext@@ -155,30 +148,33 @@   FilterForward -> i <= o   FilterNext -> i + 1 == o -recipesToDot :: RecipeGraphData -> EdgeFilter -> Dot ()+recipesToDot :: RG.RecipeGraph -> EdgeFilter -> Dot () recipesToDot graphData ef = do   Dot.attribute ("rankdir", "LR")   Dot.attribute ("ranksep", "2")   world <- diamond "World"   base <- diamond "Base"   -- ---------------------------------------------------------------------------  -- add nodes with for all the known entities-  let enames' = map (view entityName) . toList $ rgAllEntities graphData-      enames = filter (`Set.notMember` ignoredEntities) enames'-  ebmap <- Map.fromList . zip enames <$> mapM (box . unpack) enames+  -- add nodes for all the known entities+  let enames' = map (view entityName) . toList $ RG.allEntities graphData+      enames = filter (`Set.notMember` RG.ignoredEntities) enames'+  ebmap <- Map.fromList . zip enames <$> mapM (box . T.unpack) enames   -- --------------------------------------------------------------------------   -- getters for the NodeId based on entity name or the whole entity   let safeGetEntity m e = fromMaybe (error $ show e <> " is not an entity!?") $ m Map.!? e+      -- The above call to `error` (1) should never happen, and (2)+      -- even if it does, it will only crash recipe cheatsheet+      -- generation, not the game itself.       getE = safeGetEntity ebmap       nid = getE . view entityName   -- --------------------------------------------------------------------------   -- Get the starting inventories, entities present in the world and compute   -- how hard each entity is to get - see 'recipeLevels'.-  let devs = rgStartingDevices graphData-      inv = rgStartingInventory graphData-      worldEntities = rgWorldEntities graphData-      levels = rgLevels graphData-      recipes = rgRecipes graphData+  let devs = RG.startingDevices graphData+      inv = RG.startingInventory graphData+      worldEntities = RG.worldEntities graphData+      levels = RG.levels graphData+      recipes = RG.recipes graphData   -- --------------------------------------------------------------------------   -- Base inventory   (_bc, ()) <- Dot.cluster $ do@@ -242,97 +238,8 @@   mapM_ (uncurry (---<>)) (recipesToPairs recipeReqOut recipes)   -- --------------------------------------------------------------------------   -- also draw an edge for each entity that "yields" another entity-  let yieldPairs = mapMaybe (\e -> (e ^. entityName,) <$> (e ^. entityYields)) . toList $ rgAllEntities graphData+  let yieldPairs = mapMaybe (\e -> (e ^. entityName,) <$> (e ^. entityYields)) . toList $ RG.allEntities graphData   mapM_ (uncurry (.-<>.)) (both getE <$> yieldPairs)--data RecipeGraphData = RecipeGraphData-  { rgWorldEntities :: Set Entity-  , rgStartingDevices :: Set Entity-  , rgStartingInventory :: Set Entity-  , rgLevels :: [Set Entity]-  , rgAllEntities :: Set Entity-  , rgRecipes :: [Recipe Entity]-  }--classicScenarioRecipeGraphData :: IO RecipeGraphData-classicScenarioRecipeGraphData = simpleErrorHandle $ do-  (classic, GameStateInputs (ScenarioInputs worlds (TerrainEntityMaps _ emap)) recipes) <--    loadStandaloneScenario "data/scenarios/classic.yaml"-  baseRobot <- instantiateBaseRobot (classic ^. scenarioLandscape)-  let classicTerm = worlds ! "classic"-  let devs = startingDevices baseRobot-  let inv = Map.keysSet $ startingInventory baseRobot-  let worldEntities = case classicTerm of Some _ t -> extractEntities t-  return-    RecipeGraphData-      { rgStartingDevices = devs-      , rgStartingInventory = inv-      , rgWorldEntities = worldEntities-      , rgLevels = recipeLevels emap recipes (Set.unions [worldEntities, devs, inv])-      , rgAllEntities = Set.fromList . Map.elems $ entitiesByName emap-      , rgRecipes = recipes-      }---- ------------------------------------------------------------------------------- RECIPE LEVELS--- -------------------------------------------------------------------------------- | Order entities in sets depending on how soon it is possible to obtain them.------ So:---  * Level 0 - starting entities (for example those obtainable in the world)---  * Level N+1 - everything possible to make (or drill or harvest) from Level N------ This is almost a BFS, but the requirement is that the set of entities--- required for recipe is subset of the entities known in Level N.------ If we ever depend on some graph library, this could be rewritten--- as some BFS-like algorithm with added recipe nodes, but you would--- need to enforce the condition that recipes need ALL incoming edges.-recipeLevels :: EntityMap -> [Recipe Entity] -> Set Entity -> [Set Entity]-recipeLevels emap recipes start = levels- where-  recipeParts r = ((r ^. recipeInputs) <> (r ^. recipeCatalysts), r ^. recipeOutputs)-  m :: [(Set Entity, Set Entity)]-  m = map (both (Set.fromList . map snd) . recipeParts) recipes-  levels :: [Set Entity]-  levels = reverse $ go [start] start-   where-    isKnown known (i, _o) = null $ i Set.\\ known-    lookupYield e = case view entityYields e of-      Nothing -> e-      Just yn -> case E.lookupEntityName yn emap of-        Nothing -> error "unknown yielded entity"-        Just ye -> ye-    yielded = Set.map lookupYield-    nextLevel known = Set.unions $ yielded known : map snd (filter (isKnown known) m)-    go ls known =-      let n = nextLevel known Set.\\ known-       in if null n-            then ls-            else go (n : ls) (Set.union n known)--startingDevices :: Robot -> Set Entity-startingDevices = Set.fromList . map snd . E.elems . view equippedDevices--startingInventory :: Robot -> Map Entity Int-startingInventory = Map.fromList . map swap . E.elems . view robotInventory---- | Ignore utility entities that are just used for tutorials and challenges.-ignoredEntities :: Set Text-ignoredEntities =-  Set.fromList-    [ "upper left corner"-    , "upper right corner"-    , "lower left corner"-    , "lower right corner"-    , "horizontal wall"-    , "vertical wall"-    , "left and vertical wall"-    , "up and horizontal wall"-    , "right and vertical wall"-    , "down and horizontal wall"-    ]  -- ---------------------------------------------------------------------------- -- GRAPHVIZ HELPERS
src/swarm-doc/Swarm/Doc/Pedagogy.hs view
@@ -20,7 +20,8 @@  import Control.Lens (universe, view, (^.)) import Control.Monad (guard)-import Data.List (foldl', intercalate, sort, sortOn)+import Data.Foldable (Foldable (..))+import Data.List (intercalate, sort, sortOn) import Data.List.Extra (zipFrom) import Data.Map (Map) import Data.Map qualified as M@@ -31,7 +32,7 @@ import Data.Text (Text) import Data.Text qualified as T import Swarm.Constant-import Swarm.Game.Failure (SystemFailure, simpleErrorHandle)+import Swarm.Failure (SystemFailure, simpleErrorHandle) import Swarm.Game.Land import Swarm.Game.Scenario (   Scenario,@@ -44,20 +45,21 @@   scenarioSolution,  ) import Swarm.Game.Scenario.Objective (objectiveGoal)+import Swarm.Game.Scenario.Status import Swarm.Game.ScenarioInfo (   ScenarioCollection,-  ScenarioInfoPair,   flatten,   getTutorials,   loadScenarios,+  pathifyCollection,   scenarioCollectionToList,-  scenarioPath,  ) import Swarm.Game.World.Load (loadWorlds) import Swarm.Language.Syntax import Swarm.Language.Text.Markdown (docToText, findCode) import Swarm.Language.Types (Polytype) import Swarm.Util.Effect (ignoreWarnings)+import Prelude hiding (Foldable (..))  -- * Constants @@ -79,7 +81,7 @@ -- introduced in their solution and descriptions -- having been extracted data TutorialInfo = TutorialInfo-  { scenarioPair :: ScenarioInfoPair+  { scenarioPair :: ScenarioWith ScenarioPath   , tutIndex :: Int   , solutionCommands :: Map Const [SrcLoc]   , descriptionCommands :: Set Const@@ -94,8 +96,8 @@ -- * Functions  -- | Extract commands from both goal descriptions and solution code.-extractCommandUsages :: Int -> ScenarioInfoPair -> TutorialInfo-extractCommandUsages idx siPair@(s, _si) =+extractCommandUsages :: Int -> ScenarioWith ScenarioPath -> TutorialInfo+extractCommandUsages idx siPair@(ScenarioWith s _si) =   TutorialInfo siPair idx solnCommands $ getDescCommands s  where   solnCommands = getCommands maybeSoln@@ -118,7 +120,7 @@ isConsidered :: Const -> Bool isConsidered c = isUserFunc c && c `S.notMember` ignoredCommands  where-  ignoredCommands = S.fromList [Run, Return, Noop, Force]+  ignoredCommands = S.fromList [Run, Pure, Noop, Force]  -- | Extract the command names from the source code of the solution. --@@ -140,13 +142,13 @@  -- | "fold" over the tutorials in sequence to determine which -- commands are novel to each tutorial's solution.-computeCommandIntroductions :: [(Int, ScenarioInfoPair)] -> [CoverageInfo]+computeCommandIntroductions :: [(Int, ScenarioWith ScenarioPath)] -> [CoverageInfo] computeCommandIntroductions =   reverse . tuts . foldl' f initial  where   initial = CommandAccum mempty mempty -  f :: CommandAccum -> (Int, ScenarioInfoPair) -> CommandAccum+  f :: CommandAccum -> (Int, ScenarioWith ScenarioPath) -> CommandAccum   f (CommandAccum encounteredPreviously xs) (idx, siPair) =     CommandAccum updatedEncountered $ CoverageInfo usages novelCommands : xs    where@@ -158,9 +160,9 @@  -- | Extract the tutorials from the complete scenario collection -- and derive their command coverage info.-generateIntroductionsSequence :: ScenarioCollection -> [CoverageInfo]+generateIntroductionsSequence :: ScenarioCollection ScenarioInfo -> [CoverageInfo] generateIntroductionsSequence =-  computeCommandIntroductions . zipFrom 0 . getTuts+  computeCommandIntroductions . zipFrom 0 . getTuts . pathifyCollection  where   getTuts =     concatMap flatten@@ -171,7 +173,7 @@  -- | Helper for standalone rendering. -- For unit tests, can instead access the scenarios via the GameState.-loadScenarioCollection :: IO ScenarioCollection+loadScenarioCollection :: IO (ScenarioCollection ScenarioInfo) loadScenarioCollection = simpleErrorHandle $ do   tem <- loadEntitiesAndTerrain @@ -180,17 +182,17 @@   -- all the scenarios via the usual code path; we do not need to do   -- anything with them here while simply rendering pedagogy info.   worlds <- ignoreWarnings @(Seq SystemFailure) $ loadWorlds tem-  ignoreWarnings @(Seq SystemFailure) $ loadScenarios $ ScenarioInputs worlds tem+  ignoreWarnings @(Seq SystemFailure) $ loadScenarios (ScenarioInputs worlds tem) True  renderUsagesMarkdown :: CoverageInfo -> Text-renderUsagesMarkdown (CoverageInfo (TutorialInfo (s, si) idx _sCmds dCmds) novelCmds) =+renderUsagesMarkdown (CoverageInfo (TutorialInfo (ScenarioWith s (ScenarioPath sp)) idx _sCmds dCmds) novelCmds) =   T.unlines bodySections  where   bodySections = firstLine : otherLines   otherLines =     intercalate       [""]-      [ pure . surround "`" . T.pack $ view scenarioPath si+      [ pure . surround "`" . T.pack $ sp       , pure . surround "*" . T.strip . docToText $ view (scenarioOperation . scenarioDescription) s       , renderSection "Introduced in solution" . renderCmdList $ M.keysSet novelCmds       , renderSection "Referenced in description" $ renderCmdList dCmds@@ -249,7 +251,7 @@     render (cmd, tut) =       T.unwords         [ linkifyCommand cmd-        , "(" <> renderTutorialTitle (tutIndex tut) (fst $ scenarioPair tut) <> ")"+        , "(" <> renderTutorialTitle (tutIndex tut) (view getScenario $ scenarioPair tut) <> ")"         ]     renderFullCmdList = renderList . map render . sortOn fst     infos = generateIntroductionsSequence ss
src/swarm-doc/Swarm/Doc/Schema/Refined.hs view
@@ -9,6 +9,7 @@ module Swarm.Doc.Schema.Refined where  import Control.Applicative ((<|>))+import Control.Monad (unless) import Data.Aeson import Data.List.Extra (replace) import Data.List.NonEmpty (NonEmpty)@@ -122,9 +123,8 @@   theType <- maybe (fail "Unspecified sub-schema type") return maybeType   markdownDescription <- mapM getMarkdown $ _description rawSchema -  if null (_properties rawSchema) || not (fromMaybe True (_additionalProperties rawSchema))-    then return ()-    else fail "All objects must specify '\"additionalProperties\": true'"+  unless (null (_properties rawSchema) || not (fromMaybe True (_additionalProperties rawSchema))) $+    fail "All objects must specify '\"additionalProperties\": true'"    return     SwarmSchema
src/swarm-doc/Swarm/Doc/Util.hs view
@@ -7,15 +7,8 @@ -- Utilities for generating doc markup module Swarm.Doc.Util where -import Control.Effect.Throw (Has, Throw, throwError)-import Control.Lens (view)-import Data.Maybe (listToMaybe) import Data.Text (Text) import Data.Text qualified as T-import Swarm.Game.Failure (SystemFailure (CustomFailure))-import Swarm.Game.Robot (Robot)-import Swarm.Game.Robot.Concrete (instantiateRobot)-import Swarm.Game.Scenario (ScenarioLandscape, scenarioRobots) import Swarm.Language.Syntax (Const (..)) import Swarm.Language.Syntax qualified as Syntax @@ -45,8 +38,3 @@  constSyntax :: Const -> Text constSyntax = Syntax.syntax . Syntax.constInfo--instantiateBaseRobot :: Has (Throw SystemFailure) sig m => ScenarioLandscape -> m Robot-instantiateBaseRobot sLandscape = case listToMaybe $ view scenarioRobots sLandscape of-  Just r -> pure $ instantiateRobot Nothing 0 r-  Nothing -> throwError $ CustomFailure "Scenario contains no robots"
src/swarm-doc/Swarm/Doc/Wiki/Cheatsheet.hs view
@@ -28,21 +28,21 @@ import Swarm.Doc.Util import Swarm.Doc.Wiki.Matrix import Swarm.Doc.Wiki.Util+import Swarm.Failure (simpleErrorHandle) import Swarm.Game.Device qualified as D import Swarm.Game.Display (displayChar) import Swarm.Game.Entity (Entity, EntityMap (entitiesByName), entityDisplay, entityName, loadEntities) import Swarm.Game.Entity qualified as E-import Swarm.Game.Failure (simpleErrorHandle) import Swarm.Game.Recipe (Recipe, loadRecipes, recipeCatalysts, recipeInputs, recipeOutputs, recipeTime, recipeWeight) import Swarm.Game.Terrain (loadTerrain, terrainByName) import Swarm.Language.Capability (Capability) import Swarm.Language.Capability qualified as Capability-import Swarm.Language.Pretty (prettyText, prettyTextLine) import Swarm.Language.Syntax (Const (..)) import Swarm.Language.Syntax qualified as Syntax import Swarm.Language.Text.Markdown as Markdown (docToMark) import Swarm.Language.Typecheck (inferConst)-import Swarm.Util (showT)+import Swarm.Pretty (prettyText, prettyTextLine)+import Swarm.Util (applyWhen, maximum0, showT)  -- * Types @@ -67,7 +67,7 @@   Commands -> T.putStrLn commandsPage   CommandMatrix -> case pandocToText commandsMatrix of     Right x -> T.putStrLn x-    Left x -> error $ T.unpack x+    Left x -> T.putStrLn x   Capabilities -> simpleErrorHandle $ do     entities <- loadEntities     sendIO $ T.putStrLn $ capabilityPage address entities@@ -99,7 +99,7 @@   format w x = wrap ' ' x <> T.replicate (w - T.length x) " "  maxWidths :: [[Text]] -> [Int]-maxWidths = map (maximum . map T.length) . transpose+maxWidths = map (maximum0 . map T.length) . transpose  -- ** COMMANDS @@ -170,10 +170,7 @@       then t       else addLink (entityAddress <> "#" <> T.replace " " "-" t) t   linkCommand c =-    ( if T.null commandsAddress-        then id-        else addLink (commandsAddress <> "#" <> showT c)-    )+    applyWhen (not $ T.null commandsAddress) (addLink $ commandsAddress <> "#" <> showT c)       . codeQuote       $ constSyntax c @@ -188,7 +185,11 @@   header = [listToRow mw capabilityHeader, separatingLine mw]  capabilityPage :: PageAddress -> EntityMap -> Text-capabilityPage a em = capabilityTable a em enumerate+capabilityPage a em = capabilityTable a em $ filter usedCapability enumerate+ where+  usedCapability c = case c of+    Capability.CExecute con -> Capability.constCaps con == Just c+    _ -> True  -- ** Entities
src/swarm-engine/Swarm/Game/Achievement/Attainment.hs view
@@ -12,7 +12,7 @@   obtainedAt, ) where -import Control.Lens hiding (from, (<.>))+import Control.Lens (makeLenses) import Data.Aeson (   Options (..),   defaultOptions,@@ -23,7 +23,9 @@ import Data.Time (ZonedTime, zonedTimeToUTC) import Data.Yaml as Y import GHC.Generics (Generic)-import Swarm.Game.Achievement.Definitions+import Swarm.Game.Achievement.Definitions (+  CategorizedAchievement,+ )  -- | A record holding an achievement along with some metadata to --   record the time at which the achievement was obtained, and the
src/swarm-engine/Swarm/Game/Achievement/Description.hs view
@@ -103,6 +103,13 @@       "`give` something to your`self`."       Easy       True+  GameplayAchievement EquippedAllDevices ->+    AchievementInfo+      "Swiss Army Robot"+      (Just $ Freeform "You never know when that might come in handy...")+      "`equip` all craftable devices simultaneously."+      Gruelling+      True  -- | Validity conditions are required if-and-only-if the achievement -- category is 'GameplayAchievement'.@@ -116,3 +123,4 @@   GetDisoriented -> ValidityConditions OnlyPlayerRobot ExcludesCreativeMode   SwapSame -> ValidityConditions OnlyPlayerRobot ExcludesCreativeMode   GaveToSelf -> ValidityConditions OnlyPlayerRobot ExcludesCreativeMode+  EquippedAllDevices -> ValidityConditions OnlyPlayerRobot ExcludesCreativeMode
src/swarm-engine/Swarm/Game/Achievement/Persistence.hs view
@@ -13,10 +13,10 @@ import Control.Monad (forM_) import Data.Sequence (Seq) import Data.Yaml qualified as Y+import Swarm.Failure import Swarm.Game.Achievement.Attainment import Swarm.Game.Achievement.Definitions-import Swarm.Game.Failure-import Swarm.Game.ResourceLoading (getSwarmAchievementsPath)+import Swarm.ResourceLoading (getSwarmAchievementsPath) import Swarm.Util.Effect (forMW) import System.Directory (doesDirectoryExist, doesFileExist, listDirectory) import System.FilePath ((</>))
src/swarm-engine/Swarm/Game/CESK.hs view
@@ -92,13 +92,12 @@ import Swarm.Game.Ingredients (Count) import Swarm.Game.Tick import Swarm.Game.World (WorldUpdate (..))-import Swarm.Language.Context import Swarm.Language.Elaborate (insertSuspend)-import Swarm.Language.Pretty import Swarm.Language.Requirements.Type (Requirements) import Swarm.Language.Syntax import Swarm.Language.Types import Swarm.Language.Value as V+import Swarm.Pretty (PrettyPrec (..), pparens, ppr) import Swarm.Util.JSON (optionsMinimize)  ------------------------------------------------------------@@ -123,6 +122,13 @@     -- application) in environment @e@.  We will also push an 'FApp'     -- frame on the stack.     FArg Term Env+  | -- | @FVArg v@ says that we were evaluating the left-hand side of+    --   an application, and the next thing we should do is apply it+    --   to the given value.  This does not normally occur as part of+    --   the usual evaluation process for applications, which instead+    --   uses FArg.  However, it is sometimes useful when reducing+    --   other constructs---for example, the pair eliminator 'match'.+    FVArg Value   | -- | @FApp v@ says that we were evaluating the right-hand side of     -- an application; once we are done, we should pass the resulting     -- value as an argument to @v@.@@ -164,14 +170,11 @@   | -- | If an exception bubbles all the way up to this frame, then     --   switch to Suspended mode with this saved top-level context.     FRestoreEnv Env-  deriving (Eq, Show, Generic)+  deriving (Generic)  instance ToJSON Frame where   toJSON = genericToJSON optionsMinimize -instance FromJSON Frame where-  parseJSON = genericParseJSON optionsMinimize- -- | A continuation is just a stack of frames. type Cont = [Frame] @@ -184,7 +187,7 @@ -- | 'Store' represents a store, /i.e./ memory, indexing integer --   locations to 'Value's. data Store = Store {next :: Addr, mu :: IntMap Value}-  deriving (Show, Eq, Generic, FromJSON, ToJSON)+  deriving (Generic, ToJSON)  emptyStore :: Store emptyStore = Store 0 IM.empty@@ -264,14 +267,11 @@     --   evaluation, and otherwise it is just like 'In' with a hole     --   for the 'Term' we are going to evaluate.     Suspended Value Env Store Cont-  deriving (Eq, Show, Generic)+  deriving (Generic)  instance ToJSON CESK where   toJSON = genericToJSON optionsMinimize -instance FromJSON CESK where-  parseJSON = genericParseJSON optionsMinimize- -- | Is the CESK machine in a final (finished) state?  If so, extract --   the final value and store. finalValue :: CESK -> Maybe Value@@ -326,9 +326,9 @@ -- | Create a brand new CESK machine, with empty environment and --   store, to evaluate a given term.  We always initialize the --   machine with a single FExec frame as the continuation; if the---   given term does not have a command type, we wrap it in @return@.+--   given term does not have a command type, we wrap it in @pure@. initMachine :: TSyntax -> CESK-initMachine t = In (prepareTerm mempty t) mempty emptyStore [FExec]+initMachine t = In (prepareTerm V.emptyEnv t) V.emptyEnv emptyStore [FExec]  -- | Load a program into an existing robot CESK machine: either --   continue from a suspended state, or, as a fallback, start from@@ -355,18 +355,18 @@   -- In any other state, just start with an empty environment.  This   -- happens e.g. when running a program on the base robot for the   -- very first time.-  cesk -> In (insertSuspend $ prepareTerm mempty t) mempty (cesk ^. store) (FExec : (cesk ^. cont))+  cesk -> In (insertSuspend $ prepareTerm V.emptyEnv t) V.emptyEnv (cesk ^. store) (FExec : (cesk ^. cont))  -- | Prepare a term for evaluation by a CESK machine in the given --   environment: erase all type annotations, and optionally wrap it---   in @return@ if it does not have a command type.  Note that since+--   in @pure@ if it does not have a command type.  Note that since --   the environment might contain type aliases, we have to be careful --   to expand them before concluding whether the term has a command --   type or not. prepareTerm :: Env -> TSyntax -> Term prepareTerm e t = case whnfType (e ^. envTydefs) (ptBody (t ^. sType)) of   TyCmd _ -> t'-  _ -> TApp (TConst Return) t'+  _ -> TApp (TConst Pure) t'  where   t' = eraseS t @@ -411,23 +411,24 @@   FSnd t _ -> (11, "(" <> inner <> "," <+> ppr t <> ")")   FFst v -> (11, "(" <> ppr (valueToTerm v) <> "," <+> inner <> ")")   FArg t _ -> (10, pparens (p < 10) inner <+> prettyPrec 11 t)+  FVArg v -> (10, pparens (p < 10) inner <+> prettyPrec 11 (valueToTerm v))   FApp v -> (10, prettyPrec 10 (valueToTerm v) <+> pparens (p < 11) inner)-  FLet x _ t _ -> (11, hsep ["let", pretty x, "=", inner, "in", ppr t])+  FLet x _ t _ -> (11, hsep ["let", ppr x, "=", inner, "in", ppr t])   FTry v -> (10, "try" <+> pparens (p < 11) inner <+> prettyPrec 11 (valueToTerm v))   FExec -> prettyPrefix "E·" (p, inner)   FBind Nothing _ t _ -> (0, pparens (p < 1) inner <+> ";" <+> ppr t)-  FBind (Just x) _ t _ -> (0, hsep [pretty x, "<-", pparens (p < 1) inner, ";", ppr t])+  FBind (Just x) _ t _ -> (0, hsep [ppr x, "<-", pparens (p < 1) inner, ";", ppr t])   FImmediate c _worldUpds _robotUpds -> prettyPrefix ("I[" <> ppr c <> "]·") (p, inner)   FUpdate {} -> (p, inner)   FFinishAtomic -> prettyPrefix "A·" (p, inner)   FRcd _ done foc rest -> (11, encloseSep "[" "]" ", " (pDone ++ [pFoc] ++ pRest))    where-    pDone = map (\(x, v) -> pretty x <+> "=" <+> ppr (valueToTerm v)) (reverse done)-    pFoc = pretty foc <+> "=" <+> inner+    pDone = map (\(x, v) -> ppr x <+> "=" <+> ppr (valueToTerm v)) (reverse done)+    pFoc = ppr foc <+> "=" <+> inner     pRest = map pprEq rest-    pprEq (x, Nothing) = pretty x-    pprEq (x, Just t) = pretty x <+> "=" <+> ppr t-  FProj x -> (11, pparens (p < 11) inner <> "." <> pretty x)+    pprEq (x, Nothing) = ppr x+    pprEq (x, Just t) = ppr x <+> "=" <+> ppr t+  FProj x -> (11, pparens (p < 11) inner <> "." <> ppr x)   FSuspend _ -> (10, "suspend" <+> pparens (p < 11) inner)   FRestoreEnv _ -> (10, "restore" <+> pparens (p < 11) inner)
src/swarm-engine/Swarm/Game/Exception.hs view
@@ -30,10 +30,10 @@ import Swarm.Game.Entity (EntityMap, devicesForCap, entityName) import Swarm.Language.Capability (Capability (CGod), capabilityName) import Swarm.Language.JSON ()-import Swarm.Language.Pretty (prettyText) import Swarm.Language.Requirements.Type (Requirements (..)) import Swarm.Language.Syntax (Const, Term) import Swarm.Log (Severity (..))+import Swarm.Pretty (prettyText) import Swarm.Util import Witch (from) @@ -129,8 +129,8 @@ -- "obtain device", or "obtain consumables". formatIncapableFix :: IncapableFix -> IncapableFixWords formatIncapableFix = \case-  FixByEquip -> IncapableFixWords "equip" "device"-  FixByObtainDevice -> IncapableFixWords "obtain" "device"+  FixByEquip -> IncapableFixWords "equip" "device(s)"+  FixByObtainDevice -> IncapableFixWords "obtain" "device(s)"   FixByObtainConsumables -> IncapableFixWords "obtain" "consumables"  -- | Pretty print the incapable exception with an actionable suggestion@@ -139,11 +139,11 @@ -- >>> import Data.Either (fromRight) -- >>> import Control.Carrier.Throw.Either (runThrow) -- >>> import Control.Algebra (run)--- >>> import Swarm.Game.Failure (LoadingFailure)+-- >>> import Swarm.Failure (LoadingFailure) -- >>> import qualified Data.Set as S -- >>> :set -XTypeApplications--- >>> w = mkEntity (defaultEntityDisplay 'l') "magic wand" mempty mempty (S.singleton CAppear)--- >>> r = mkEntity (defaultEntityDisplay 'o') "the one ring" mempty mempty (S.singleton CAppear)+-- >>> w = mkEntity (defaultEntityDisplay 'l') "magic wand" mempty mempty (S.singleton $ CExecute Appear)+-- >>> r = mkEntity (defaultEntityDisplay 'o') "the one ring" mempty mempty (S.singleton $ CExecute Appear) -- >>> m = fromRight mempty . run . runThrow @LoadingFailure $ buildEntityMap [w,r] -- >>> incapableError cs t = putStr . unpack $ formatIncapable m FixByEquip cs t --@@ -152,13 +152,13 @@ --   'as' --   If God in troth thou wantest to play, try thou a Creative game. ----- >>> incapableError (R.singletonCap CAppear) (TConst Appear)--- You do not have the device required for:+-- >>> incapableError (R.singletonCap $ CExecute Appear) (TConst Appear)+-- You do not have the device(s) required for: --   'appear' --   Please equip: --   - magic wand or the one ring ----- >>> incapableError (R.singletonCap CRandom) (TConst Random)+-- >>> incapableError (R.singletonCap $ CExecute Random) (TConst Random) -- Missing the random capability for: --   'random' --   but no device yet provides it. See
+ src/swarm-engine/Swarm/Game/Popup.hs view
@@ -0,0 +1,62 @@+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE TemplateHaskell #-}++module Swarm.Game.Popup (+  -- * Popup types+  Popup (..),++  -- * Popup state+  PopupState,+  currentPopup,+  popupQueue,+  initPopupState,+  addPopup,+  nextPopup,+) where++import Control.Lens (makeLenses, use, (%~), (.=))+import Control.Monad.State (MonadState)+import Data.Sequence (Seq, (|>), pattern (:<|))+import Data.Sequence qualified as Seq+import Swarm.Game.Achievement.Definitions (CategorizedAchievement)+import Swarm.Language.Syntax (Const)++-- | Different types of popups that can be displayed to the+--   player.+data Popup+  = AchievementPopup CategorizedAchievement+  | RecipesPopup+  | CommandsPopup [Const]+  | DebugWarningPopup++-- | State to track pending popup queue as well as any+--   popup which is currently being displayed.+data PopupState = PopupState+  { _currentPopup :: Maybe Popup+  , _popupQueue :: Seq Popup+  }++makeLenses ''PopupState++-- | Initial, empty popup state.+initPopupState :: PopupState+initPopupState =+  PopupState+    { _currentPopup = Nothing+    , _popupQueue = Seq.empty+    }++-- | Add a popup to the end of the queue.+addPopup :: Popup -> PopupState -> PopupState+addPopup notif = popupQueue %~ (|> notif)++-- | Move the next popup (if any) from the queue to the+--   currently displayed popup.+nextPopup :: MonadState PopupState m => m ()+nextPopup = do+  q <- use popupQueue+  case q of+    Seq.Empty -> currentPopup .= Nothing+    n :<| ns -> do+      currentPopup .= Just n+      popupQueue .= ns
src/swarm-engine/Swarm/Game/Robot/Activity.hs view
@@ -16,7 +16,7 @@  import Control.Lens hiding (Const, contains) import Data.Aeson qualified as Ae (FromJSON (..), ToJSON (..))-import Data.Map (Map)+import Data.Map.Strict (Map) import GHC.Generics (Generic) import Swarm.Game.Tick import Swarm.Language.Syntax (Const)
src/swarm-engine/Swarm/Game/Robot/Concrete.hs view
@@ -141,7 +141,7 @@     Ae.object $       catMaybes         [ "id" .== (r ^. robotID)-        , "name" .== (r ^. robotEntity . entityDisplay)+        , "name" .== (r ^. robotEntity . entityName)         , "description" .=? (r ^. robotEntity . entityDescription) $ mempty         , "loc" .== (r ^. robotLocation)         , "dir" .=? (r ^. robotEntity . entityOrientation) $ zero
src/swarm-engine/Swarm/Game/Scenario/Scoring/Best.hs view
@@ -144,7 +144,7 @@ getBestGroups =   rearrangeTuples . M.toList . bestToMap  where-  groupByStartTime = NE.groupAllWith $ view scenarioStarted . getMetric . snd+  groupByStartTime = NE.groupAllWith $ view scenarioStarted . view metricData . snd   rearrangeTuples = map (snd . NE.head &&& NE.map fst) . groupByStartTime    bestToMap :: BestRecords -> Map BestByCriteria ProgressMetric@@ -161,4 +161,4 @@       ]      ensurePresent x =-      (getMetric x ^. scenarioAttemptMetrics . scenarioCodeMetrics) >> Just x+      (x ^. metricData . scenarioAttemptMetrics . scenarioCodeMetrics) >> Just x
src/swarm-engine/Swarm/Game/Scenario/Scoring/CodeSize.hs view
@@ -12,7 +12,7 @@ import Swarm.Language.Syntax  data CodeSizeDeterminators = CodeSizeDeterminators-  { initialCode :: Maybe TSyntax+  { initialCode :: Maybe Syntax   , hasUsedREPL :: Bool   }   deriving (Show)
src/swarm-engine/Swarm/Game/Scenario/Scoring/GenericMetrics.hs view
@@ -1,15 +1,27 @@+{-# LANGUAGE TemplateHaskell #-}+ -- | -- SPDX-License-Identifier: BSD-3-Clause -- -- Data types and functions applicable across different -- scoring methods.-module Swarm.Game.Scenario.Scoring.GenericMetrics where+module Swarm.Game.Scenario.Scoring.GenericMetrics (+  Progress (..),+  Metric (Metric),+  metricProgress,+  metricData,+  chooseBetter,+) where +import Control.Applicative ((<|>))+import Control.Lens import Data.Aeson+import Data.List.Extra (dropPrefix) import Data.Ord (Down (Down)) import GHC.Generics (Generic) import Swarm.Util (maxOn)-import Swarm.Util.JSON (optionsUntagged)+import Swarm.Util.JSON (optionsMinimize, optionsUntagged)+import Swarm.Util.Lens (makeLensesNoSigs)  -- | This is a subset of the "ScenarioStatus" type -- that excludes the "NotStarted" case.@@ -24,11 +36,30 @@ instance ToJSON Progress where   toJSON = genericToJSON optionsUntagged -data Metric a = Metric Progress a-  deriving (Eq, Ord, Show, Read, Generic, FromJSON, ToJSON)+data Metric a = Metric+  { _metricProgress :: Progress+  , _metricData :: a+  }+  deriving (Eq, Ord, Show, Read, Generic) -getMetric :: Metric a -> a-getMetric (Metric _ x) = x+metricSerializeOptions :: Options+metricSerializeOptions = optionsMinimize {fieldLabelModifier = camelTo2 '_' . dropPrefix "_metric"}++instance FromJSON a => FromJSON (Metric a) where+  parseJSON v =+    (uncurry Metric <$> parseJSON v) -- parse saves from time when metric did not have named fields+      <|> genericParseJSON metricSerializeOptions v++instance ToJSON a => ToJSON (Metric a) where+  toJSON = genericToJSON metricSerializeOptions++makeLensesNoSigs ''Metric++-- | The player progress, so that we know if this game was completed.+metricProgress :: Lens' (Metric a) Progress++-- | Metric data, for example start and end time.+metricData :: Lens' (Metric a) a  -- | This encodes the notion of "more play is better" -- for incomplete games (rationale: more play = more fun),
src/swarm-engine/Swarm/Game/Scenario/Status.hs view
@@ -16,6 +16,7 @@   genericToJSON,  ) import Data.Function (on)+import Data.String (IsString (..)) import Data.Time (ZonedTime, diffUTCTime, zonedTimeToUTC) import Data.Yaml as Y import GHC.Generics (Generic)@@ -67,9 +68,6 @@   toEncoding = genericToEncoding scenarioOptions   toJSON = genericToJSON scenarioOptions -seedLaunchParams :: Applicative f => Maybe Seed -> ParameterizableLaunchParams a f-seedLaunchParams s = LaunchParams (pure s) (pure Nothing)- emptyLaunchParams :: Applicative f => ParameterizableLaunchParams a f emptyLaunchParams = LaunchParams (pure Nothing) (pure Nothing) @@ -78,32 +76,55 @@   NotStarted -> emptyLaunchParams   Played x _ _ -> x +-- | The normalized path to a scenario, amenable to lookup+newtype ScenarioPath = ScenarioPath+  { getScenarioPath :: FilePath+  }+  deriving (Eq, Show)++instance IsString ScenarioPath where+  fromString = ScenarioPath++data ScenarioWith a = ScenarioWith+  { _getScenario :: Scenario+  , _getScenarioInfo :: a+  }+  deriving (Generic, Functor)++makeLenses ''ScenarioWith+ -- | A 'ScenarioInfo' record stores metadata about a scenario: its -- canonical path and status. -- By way of the 'ScenarioStatus' record, it stores the -- most recent status and best-ever status.-data ScenarioInfo = ScenarioInfo-  { _scenarioPath :: FilePath+data ScenarioInfoT a = ScenarioInfo+  { _scenarioPath :: a   , _scenarioStatus :: ScenarioStatus   }-  deriving (Eq, Ord, Show, Read, Generic)+  deriving (Eq, Ord, Show, Read, Generic, Functor) -instance FromJSON ScenarioInfo where+type ScenarioInfo = ScenarioInfoT FilePath++instance (FromJSON a) => FromJSON (ScenarioInfoT a) where   parseJSON = genericParseJSON scenarioOptions -instance ToJSON ScenarioInfo where+instance (ToJSON a) => ToJSON (ScenarioInfoT a) where   toEncoding = genericToEncoding scenarioOptions   toJSON = genericToJSON scenarioOptions -type ScenarioInfoPair = (Scenario, ScenarioInfo)--makeLensesNoSigs ''ScenarioInfo+makeLensesNoSigs ''ScenarioInfoT  -- | The path of the scenario, relative to @data/scenarios@. scenarioPath :: Lens' ScenarioInfo FilePath  -- | The status of the scenario. scenarioStatus :: Lens' ScenarioInfo ScenarioStatus++-- | Check if a given scenario has been completed.+scenarioIsCompleted :: ScenarioInfo -> Bool+scenarioIsCompleted (ScenarioInfo _ (Played _ _ best)) =+  best ^. scenarioBestByTime . metricProgress == Completed+scenarioIsCompleted _ = False  -- | Update the current 'ScenarioInfo' record when quitting a game. --
− src/swarm-engine/Swarm/Game/Scenario/Topography/Structure/Recognition/Tracking.hs 
@@ -1,215 +0,0 @@--- |--- SPDX-License-Identifier: BSD-3-Clause------ Online operations for structure recognizer.------ See "Swarm.Game.Scenario.Topography.Structure.Recognition.Precompute" for--- details of the structure recognition process.-module Swarm.Game.Scenario.Topography.Structure.Recognition.Tracking (-  entityModified,-) where--import Control.Carrier.State.Lazy-import Control.Effect.Lens-import Control.Lens ((^.))-import Control.Monad (forM, forM_, guard)-import Data.HashMap.Strict qualified as HM-import Data.HashSet (HashSet)-import Data.HashSet qualified as HS-import Data.Hashable (Hashable)-import Data.Int (Int32)-import Data.List (sortOn)-import Data.List.NonEmpty qualified as NE-import Data.Map qualified as M-import Data.Maybe (listToMaybe)-import Data.Ord (Down (..))-import Data.Semigroup (Max (..), Min (..))-import Linear (V2 (..))-import Swarm.Game.Entity (Entity)-import Swarm.Game.Location (Location)-import Swarm.Game.Scenario (StructureCells)-import Swarm.Game.Scenario.Topography.Structure.Recognition-import Swarm.Game.Scenario.Topography.Structure.Recognition.Log-import Swarm.Game.Scenario.Topography.Structure.Recognition.Registry-import Swarm.Game.Scenario.Topography.Structure.Recognition.Type-import Swarm.Game.State-import Swarm.Game.State.Substate-import Swarm.Game.Universe-import Swarm.Game.World.Modify-import Text.AhoCorasick---- | A hook called from the centralized entity update function,--- 'Swarm.Game.Step.Util.updateEntityAt'.------ This handles structure detection upon addition of an entity,--- and structure de-registration upon removal of an entity.--- Also handles atomic entity swaps.-entityModified ::-  (Has (State GameState) sig m) =>-  CellModification Entity ->-  Cosmic Location ->-  m ()-entityModified modification cLoc = do-  case modification of-    Add newEntity -> doAddition newEntity-    Remove _ -> doRemoval-    Swap _ newEntity -> doRemoval >> doAddition newEntity- where-  doAddition newEntity = do-    entLookup <- use $ discovery . structureRecognition . automatons . automatonsByEntity-    forM_ (HM.lookup newEntity entLookup) $ \finder -> do-      let msg = FoundParticipatingEntity $ ParticipatingEntity newEntity (finder ^. inspectionOffsets)-      discovery . structureRecognition . recognitionLog %= (msg :)-      registerRowMatches cLoc finder--  doRemoval = do-    -- Entity was removed; may need to remove registered structure.-    structureRegistry <- use $ discovery . structureRecognition . foundStructures-    forM_ (M.lookup cLoc $ foundByLocation structureRegistry) $ \fs -> do-      let structureName = getName $ originalDefinition $ structureWithGrid fs-       in do-            discovery . structureRecognition . recognitionLog %= (StructureRemoved structureName :)-            discovery . structureRecognition . foundStructures %= removeStructure fs---- | In case this cell would match a candidate structure,--- ensures that the entity in this cell is not already--- participating in a registered structure.------ Furthermore, treating cells in registered structures--- as 'Nothing' has the effect of "masking" them out,--- so that they can overlap empty cells within the bounding--- box of the candidate structure.------ Finally, entities that are not members of any candidate--- structure are also masked out, so that it is OK for them--- to intrude into the candidate structure's bounding box--- where the candidate structure has empty cells.-candidateEntityAt ::-  (Has (State GameState) sig m) =>-  -- | participating entities-  HashSet Entity ->-  Cosmic Location ->-  m (Maybe Entity)-candidateEntityAt participating cLoc = do-  registry <- use $ discovery . structureRecognition . foundStructures-  if M.member cLoc $ foundByLocation registry-    then return Nothing-    else do-      maybeEnt <- entityAt cLoc-      return $ do-        ent <- maybeEnt-        guard $ HS.member ent participating-        return ent---- | Excludes entities that are already part of a--- registered found structure.-getWorldRow ::-  (Has (State GameState) sig m) =>-  -- | participating entities-  HashSet Entity ->-  Cosmic Location ->-  InspectionOffsets ->-  Int32 ->-  m [Maybe Entity]-getWorldRow participatingEnts cLoc (InspectionOffsets (Min offsetLeft) (Max offsetRight)) yOffset =-  mapM (candidateEntityAt participatingEnts) horizontalOffsets- where-  horizontalOffsets = map mkLoc [offsetLeft .. offsetRight]--  -- NOTE: We negate the yOffset because structure rows are numbered increasing from top-  -- to bottom, but swarm world coordinates increase from bottom to top.-  mkLoc x = cLoc `offsetBy` V2 x (negate yOffset)---- | This is the first (one-dimensional) stage--- in a two-stage (two-dimensional) search.-registerRowMatches ::-  (Has (State GameState) sig m) =>-  Cosmic Location ->-  AutomatonInfo Entity (AtomicKeySymbol Entity) (StructureSearcher StructureCells Entity) ->-  m ()-registerRowMatches cLoc (AutomatonInfo participatingEnts horizontalOffsets sm) = do-  entitiesRow <- getWorldRow participatingEnts cLoc horizontalOffsets 0-  let candidates = findAll sm entitiesRow-      mkCandidateLogEntry c =-        FoundRowCandidate-          (HaystackContext entitiesRow (HaystackPosition $ pIndex c))-          (needleContent $ pVal c)-          rowMatchInfo-       where-        rowMatchInfo = NE.toList . NE.map (f . myRow) . singleRowItems $ pVal c-         where-          f x = MatchingRowFrom (rowIndex x) $ getName . originalDefinition . wholeStructure $ x--      logEntry = FoundRowCandidates $ map mkCandidateLogEntry candidates--  discovery . structureRecognition . recognitionLog %= (logEntry :)-  candidates2D <- forM candidates $ checkVerticalMatch cLoc horizontalOffsets-  registerStructureMatches $ concat candidates2D--checkVerticalMatch ::-  (Has (State GameState) sig m) =>-  Cosmic Location ->-  -- | Horizontal search offsets-  InspectionOffsets ->-  Position (StructureSearcher StructureCells Entity) ->-  m [FoundStructure StructureCells Entity]-checkVerticalMatch cLoc (InspectionOffsets (Min searchOffsetLeft) _) foundRow =-  getMatches2D cLoc horizontalFoundOffsets $ automaton2D $ pVal foundRow- where-  foundLeftOffset = searchOffsetLeft + fromIntegral (pIndex foundRow)-  foundRightInclusiveIndex = foundLeftOffset + fromIntegral (pLength foundRow) - 1-  horizontalFoundOffsets = InspectionOffsets (pure foundLeftOffset) (pure foundRightInclusiveIndex)--getFoundStructures ::-  Hashable keySymb =>-  (Int32, Int32) ->-  Cosmic Location ->-  StateMachine keySymb (StructureWithGrid StructureCells Entity) ->-  [keySymb] ->-  [FoundStructure StructureCells Entity]-getFoundStructures (offsetTop, offsetLeft) cLoc sm entityRows =-  map mkFound candidates- where-  candidates = findAll sm entityRows-  mkFound candidate = FoundStructure (pVal candidate) $ cLoc `offsetBy` loc-   where-    -- NOTE: We negate the yOffset because structure rows are numbered increasing from top-    -- to bottom, but swarm world coordinates increase from bottom to top.-    loc = V2 offsetLeft $ negate $ offsetTop + fromIntegral (pIndex candidate)--getMatches2D ::-  (Has (State GameState) sig m) =>-  Cosmic Location ->-  -- | Horizontal found offsets (inclusive indices)-  InspectionOffsets ->-  AutomatonInfo Entity (SymbolSequence Entity) (StructureWithGrid StructureCells Entity) ->-  m [FoundStructure StructureCells Entity]-getMatches2D-  cLoc-  horizontalFoundOffsets@(InspectionOffsets (Min offsetLeft) _)-  (AutomatonInfo participatingEnts (InspectionOffsets (Min offsetTop) (Max offsetBottom)) sm) = do-    entityRows <- mapM getRow verticalOffsets-    return $ getFoundStructures (offsetTop, offsetLeft) cLoc sm entityRows-   where-    getRow = getWorldRow participatingEnts cLoc horizontalFoundOffsets-    verticalOffsets = [offsetTop .. offsetBottom]---- |--- We only allow an entity to participate in one structure at a time,--- so multiple matches require a tie-breaker.--- The largest structure (by area) shall win.-registerStructureMatches ::-  (Has (State GameState) sig m) =>-  [FoundStructure StructureCells Entity] ->-  m ()-registerStructureMatches unrankedCandidates = do-  discovery . structureRecognition . recognitionLog %= (newMsg :)--  forM_ (listToMaybe rankedCandidates) $ \fs ->-    discovery . structureRecognition . foundStructures %= addFound fs- where-  -- Sorted by decreasing order of preference.-  rankedCandidates = sortOn Down unrankedCandidates--  getStructName (FoundStructure swg _) = getName $ originalDefinition swg-  newMsg = FoundCompleteStructureCandidates $ map getStructName rankedCandidates
src/swarm-engine/Swarm/Game/ScenarioInfo.hs view
@@ -1,4 +1,6 @@ {-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}  -- | -- SPDX-License-Identifier: BSD-3-Clause@@ -9,11 +11,11 @@   -- * Scenario info   ScenarioStatus (..),   _NotStarted,-  ScenarioInfo (..),+  ScenarioInfo,   scenarioPath,   scenarioStatus,   CodeSizeDeterminators (CodeSizeDeterminators),-  ScenarioInfoPair,+  ScenarioWith,    -- * Scenario collection   ScenarioCollection (..),@@ -24,6 +26,7 @@   ScenarioItem (..),   scenarioItemName,   _SISingle,+  pathifyCollection,    -- ** Tutorials   tutorialsDirname,@@ -42,7 +45,7 @@ import Control.Effect.Lift (Lift, sendIO) import Control.Effect.Throw (Throw, liftEither) import Control.Lens hiding (from, (<.>))-import Control.Monad (filterM, forM_, when, (<=<))+import Control.Monad (filterM, forM_, void, when, (<=<)) import Control.Monad.IO.Class (MonadIO (liftIO)) import Data.Char (isSpace) import Data.Either (partitionEithers)@@ -51,33 +54,69 @@ import Data.List.NonEmpty qualified as NE import Data.Map (Map) import Data.Map qualified as M+import Data.Map.Ordered (OMap)+import Data.Map.Ordered qualified as OM import Data.Maybe (isJust) import Data.Sequence (Seq) import Data.Sequence qualified as Seq import Data.Text (Text) import Data.Yaml as Y-import Swarm.Game.Failure-import Swarm.Game.ResourceLoading (getDataDirSafe, getSwarmSavePath)+import Swarm.Failure import Swarm.Game.Scenario import Swarm.Game.Scenario.Scoring.CodeSize import Swarm.Game.Scenario.Status+import Swarm.ResourceLoading (getDataDirSafe, getSwarmSavePath)+import Swarm.Util (lookupEither) import Swarm.Util.Effect (warn, withThrow) import System.Directory (canonicalizePath, doesDirectoryExist, doesFileExist, listDirectory) import System.FilePath (pathSeparator, splitDirectories, takeBaseName, takeExtensions, (-<.>), (</>))+import System.IO (readFile')+import System.IO.Error (catchIOError) import Witch (into) +------------------------------------------------------------++-- * Utilities++-- | Given an ordered list of keys and a map, return a partition consisting of:+-- * Left: the keys that were not present+-- * Right: the retrievable key-value pairs in corresponding order to the provided keys+lookupInOrder :: Ord k => Map k v -> [k] -> ([k], [(k, v)])+lookupInOrder m = partitionEithers . map produceKeyValuePair+ where+  produceKeyValuePair k = sequenceA (k, lookupEither k m)++-- ** Ordered Map utilities++type instance Index (OMap k a) = k+type instance IxValue (OMap k a) = a++-- | Adapted from:+-- https://hackage.haskell.org/package/lens-5.3.4/docs/src/Control.Lens.At.html#line-319+instance Ord k => Ixed (OMap k a) where+  ix k f m = case OM.lookup k m of+    Just v -> f v <&> \v' -> OM.alter (const $ Just v') k m+    Nothing -> pure m++-- | Strangely, an 'elems' function is missing from the 'OMap' API.+orderedElems :: OMap k a -> [a]+orderedElems = map snd . OM.assocs++fromMapOM :: Ord k => Map k a -> OMap k a+fromMapOM = OM.fromList . M.toList+ -- ---------------------------------------------------------------------------- -- Scenario Item -- ----------------------------------------------------------------------------  -- | A scenario item is either a specific scenario, or a collection of --   scenarios (/e.g./ the scenarios contained in a subdirectory).-data ScenarioItem = SISingle ScenarioInfoPair | SICollection Text ScenarioCollection-  deriving (Show)+data ScenarioItem a = SISingle (ScenarioWith a) | SICollection Text (ScenarioCollection a)+  deriving (Functor)  -- | Retrieve the name of a scenario item.-scenarioItemName :: ScenarioItem -> Text-scenarioItemName (SISingle (s, _ss)) = s ^. scenarioMetadata . scenarioName+scenarioItemName :: ScenarioItem a -> Text+scenarioItemName (SISingle (ScenarioWith s _ss)) = s ^. scenarioMetadata . scenarioName scenarioItemName (SICollection name _) = name  -- | A scenario collection is a tree of scenarios, keyed by name,@@ -85,21 +124,23 @@ -- --   /Invariant:/ every item in the --   'scOrder' exists as a key in the 'scMap'.-data ScenarioCollection = SC-  { scOrder :: Maybe [FilePath]-  , scMap :: Map FilePath ScenarioItem+newtype ScenarioCollection a = SC+  { scMap :: OMap FilePath (ScenarioItem a)   }-  deriving (Show)+  deriving (Functor) +pathifyCollection :: Functor f => f ScenarioInfo -> f ScenarioPath+pathifyCollection = fmap (ScenarioPath . view scenarioPath)+ -- | Access and modify 'ScenarioItem's in collection based on their path.-scenarioItemByPath :: FilePath -> Traversal' ScenarioCollection ScenarioItem+scenarioItemByPath :: FilePath -> Traversal' (ScenarioCollection a) (ScenarioItem a) scenarioItemByPath path = ixp ps  where   ps = splitDirectories path-  ixp :: (Applicative f) => [String] -> (ScenarioItem -> f ScenarioItem) -> ScenarioCollection -> f ScenarioCollection+  ixp :: (Applicative f) => [String] -> (ScenarioItem a -> f (ScenarioItem a)) -> ScenarioCollection a -> f (ScenarioCollection a)   ixp [] _ col = pure col-  ixp [s] f (SC n m) = SC n <$> ix s f m-  ixp (d : xs) f (SC n m) = SC n <$> ix d inner m+  ixp [s] f (SC m) = SC <$> ix s f m+  ixp (d : xs) f (SC m) = SC <$> ix d inner m    where     inner si = case si of       SISingle {} -> pure si@@ -111,15 +152,15 @@  -- | Extract just the collection of tutorial scenarios from the entire --   scenario collection.-getTutorials :: ScenarioCollection -> ScenarioCollection-getTutorials sc = case M.lookup tutorialsDirname (scMap sc) of+getTutorials :: ScenarioCollection a -> ScenarioCollection a+getTutorials sc = case OM.lookup tutorialsDirname (scMap sc) of   Just (SICollection _ c) -> c-  _ -> error $ "No tutorials exist: " ++ show sc+  _ -> SC OM.empty  -- | Canonicalize a scenario path, making it usable as a unique key. normalizeScenarioPath ::   (MonadIO m) =>-  ScenarioCollection ->+  ScenarioCollection a ->   FilePath ->   m FilePath normalizeScenarioPath col p =@@ -128,19 +169,18 @@         then return path         else liftIO $ do           canonPath <- canonicalizePath path-          eitherDdir <- runM . runThrow @SystemFailure $ getDataDirSafe Scenarios "." -- no way we got this far without data directory-          d <- canonicalizePath $ fromRight' eitherDdir+          eitherDataDir <- runM . runThrow @SystemFailure $ getDataDirSafe Scenarios "." -- no way we got this far without data directory+          d <- canonicalizePath $ fromRight' eitherDataDir           let n =                 stripPrefix (d </> "scenarios") canonPath                   & maybe canonPath (dropWhile (== pathSeparator))           return n  -- | Convert a scenario collection to a list of scenario items.-scenarioCollectionToList :: ScenarioCollection -> [ScenarioItem]-scenarioCollectionToList (SC Nothing m) = M.elems m-scenarioCollectionToList (SC (Just order) m) = (m M.!) <$> order+scenarioCollectionToList :: ScenarioCollection a -> [ScenarioItem a]+scenarioCollectionToList (SC xs) = orderedElems xs -flatten :: ScenarioItem -> [ScenarioInfoPair]+flatten :: ScenarioItem a -> [ScenarioWith a] flatten (SISingle p) = [p] flatten (SICollection _ c) = concatMap flatten $ scenarioCollectionToList c @@ -148,85 +188,91 @@ loadScenarios ::   (Has (Accum (Seq SystemFailure)) sig m, Has (Lift IO) sig m) =>   ScenarioInputs ->-  m ScenarioCollection-loadScenarios scenarioInputs = do+  Bool ->+  m (ScenarioCollection ScenarioInfo)+loadScenarios scenarioInputs loadTestScenarios = do   res <- runThrow @SystemFailure $ getDataDirSafe Scenarios "scenarios"   case res of     Left err -> do       warn err-      return $ SC mempty mempty-    Right dataDir -> loadScenarioDir scenarioInputs dataDir+      return $ SC OM.empty+    Right dataDir -> loadScenarioDir scenarioInputs loadTestScenarios dataDir  -- | The name of the special file which indicates the order of --   scenarios in a folder. orderFileName :: FilePath orderFileName = "00-ORDER.txt" -readOrderFile :: (Has (Lift IO) sig m) => FilePath -> m [String]-readOrderFile orderFile =-  filter (not . null) . lines <$> sendIO (readFile orderFile)+testingDirectory :: FilePath+testingDirectory = "Testing" --- | Recursively load all scenarios from a particular directory, and also load---   the 00-ORDER file (if any) giving the order for the scenarios.+readOrderFile :: FilePath -> IO (Maybe [String])+readOrderFile orderFile = fmap nonEmptyLines <$> readFileMaybe orderFile+ where+  nonEmptyLines :: String -> [String]+  nonEmptyLines = filter (not . null) . lines+  readFileMaybe :: FilePath -> IO (Maybe String)+  readFileMaybe path = (Just <$> readFile' path) `catchIOError` (\_ -> return Nothing)+ loadScenarioDir ::+  forall m sig.   (Has (Accum (Seq SystemFailure)) sig m, Has (Lift IO) sig m) =>   ScenarioInputs ->+  Bool ->   FilePath ->-  m ScenarioCollection-loadScenarioDir scenarioInputs dir = do-  let orderFile = dir </> orderFileName-      dirName = takeBaseName dir-  orderExists <- sendIO $ doesFileExist orderFile-  morder <- case orderExists of-    False -> do-      when (dirName /= "Testing") . warn $-        OrderFileWarning (dirName </> orderFileName) NoOrderFile-      return Nothing-    True -> Just <$> readOrderFile orderFile-  itemPaths <- sendIO $ keepYamlOrPublicDirectory dir =<< listDirectory dir--  case morder of-    Just order -> do-      let missing = itemPaths \\ order-          dangling = order \\ itemPaths--      forM_ (NE.nonEmpty missing) $-        warn-          . OrderFileWarning (dirName </> orderFileName)-          . MissingFiles+  m (ScenarioCollection ScenarioInfo)+loadScenarioDir scenarioInputs loadTestScenarios dir = do+  itemPaths <- sendIO $ filterM (isYamlOrPublicDirectory dir) =<< listDirectory dir+  scenarioMap <- loadItems itemPaths+  sendIO (readOrderFile orderFile) >>= \case+    Nothing -> loadUnorderedScenarioDir scenarioMap+    Just order -> loadOrderedScenarioDir order scenarioMap+ where+  dirName, orderFile, orderFileShortPath :: FilePath+  dirName = takeBaseName dir+  orderFile = dir </> orderFileName+  orderFileShortPath = dirName </> orderFileName -      forM_ (NE.nonEmpty dangling) $-        warn-          . OrderFileWarning (dirName </> orderFileName)-          . DanglingFiles-    Nothing -> pure ()+  -- The function for individual directory items either warns about SystemFailure,+  -- or has thrown SystemFailure. The following code just adds that thrown failure to others.+  loadItems :: [FilePath] -> m (Map FilePath (ScenarioItem ScenarioInfo))+  loadItems items = do+    let loadItem f = runThrow @SystemFailure $ (f,) <$> loadScenarioItem scenarioInputs loadTestScenarios (dir </> f)+    (scenarioFailures, okScenarios) <- partitionEithers <$> mapM loadItem items+    add (Seq.fromList scenarioFailures)+    return $ M.fromList okScenarios -  -- Only keep the files from 00-ORDER.txt that actually exist.-  let morder' = filter (`elem` itemPaths) <$> morder-      loadItem filepath = do-        item <- loadScenarioItem scenarioInputs (dir </> filepath)-        return (filepath, item)-  scenarios <- mapM (runThrow @SystemFailure . loadItem) itemPaths-  let (failures, successes) = partitionEithers scenarios-      scenarioMap = M.fromList successes-      -- Now only keep the files that successfully parsed.-      morder'' = filter (`M.member` scenarioMap) <$> morder'-      collection = SC morder'' scenarioMap-  add (Seq.fromList failures) -- Register failed individual scenarios as warnings-  return collection- where-  -- Keep only files which are .yaml files or directories that start-  -- with something other than an underscore.-  keepYamlOrPublicDirectory = filterM . isCatalogEntry+  isHiddenDir :: String -> Bool+  isHiddenDir f = not loadTestScenarios && f == testingDirectory -  -- Whether the directory or file should be included in the scenario catalog.-  isCatalogEntry d f = do+  -- Keep only files which are .yaml files or directories not starting with an underscore.+  -- Marked directories contain scenarios that can't be parsed (failure tests) or only script solutions.+  isYamlOrPublicDirectory :: FilePath -> String -> IO Bool+  isYamlOrPublicDirectory d f = do     isDir <- doesDirectoryExist $ d </> f     return $       if isDir-        then not $ "_" `isPrefixOf` f+        then not ("_" `isPrefixOf` f || isHiddenDir f)         else takeExtensions f == ".yaml" +  -- warn that the ORDER file is missing+  loadUnorderedScenarioDir :: Map FilePath (ScenarioItem a) -> m (ScenarioCollection a)+  loadUnorderedScenarioDir scenarioMap = do+    when (dirName /= testingDirectory) (warn $ OrderFileWarning orderFileShortPath NoOrderFile)+    pure . SC $ fromMapOM scenarioMap++  -- warn if the ORDER file does not match directory contents+  loadOrderedScenarioDir :: [String] -> Map FilePath (ScenarioItem a) -> m (ScenarioCollection a)+  loadOrderedScenarioDir order scenarioMap = do+    let missing = M.keys scenarioMap \\ order+        (notPresent, loaded) = lookupInOrder scenarioMap order+        dangling = filter (not . isHiddenDir) notPresent++    forM_ (NE.nonEmpty missing) (warn . OrderFileWarning orderFileShortPath . MissingFiles)+    forM_ (NE.nonEmpty dangling) (warn . OrderFileWarning orderFileShortPath . DanglingFiles)++    pure $ SC $ OM.fromList loaded+ -- | How to transform scenario path to save path. scenarioPathToSavePath :: FilePath -> FilePath -> FilePath scenarioPathToSavePath path swarmData = swarmData </> Data.List.intercalate "_" (splitDirectories path)@@ -237,17 +283,21 @@   FilePath ->   m ScenarioInfo loadScenarioInfo p = do-  path <- sendIO $ normalizeScenarioPath (SC Nothing mempty) p+  path <- sendIO $ normalizeScenarioPath (SC OM.empty) p   infoPath <- sendIO $ scenarioPathToSavePath path <$> getSwarmSavePath False   hasInfo <- sendIO $ doesFileExist infoPath   if not hasInfo     then do       return $         ScenarioInfo path NotStarted-    else-      withThrow (AssetNotLoaded (Data Scenarios) infoPath . CanNotParseYaml)-        . (liftEither <=< sendIO)-        $ decodeFileEither infoPath+    else do+      si <-+        withThrow (AssetNotLoaded (Data Scenarios) infoPath . CanNotParseYaml)+          . (liftEither <=< sendIO)+          $ decodeFileEither infoPath+      -- We overwrite the (void) path that was saved inside the yaml file, so that there+      -- is only a single authoritative path "key": the original scenario path.+      return $ path <$ (si :: ScenarioInfoT ())  -- | Save info about played scenario to XDG data directory. saveScenarioInfo ::@@ -256,7 +306,8 @@   IO () saveScenarioInfo path si = do   infoPath <- scenarioPathToSavePath path <$> getSwarmSavePath True-  encodeFile infoPath si+  -- We do not store the path in the save file (see #2390).+  encodeFile infoPath $ void si  -- | Load a scenario item (either a scenario, or a subdirectory --   containing a collection of scenarios) from a particular path.@@ -266,21 +317,22 @@   , Has (Lift IO) sig m   ) =>   ScenarioInputs ->+  Bool ->   FilePath ->-  m ScenarioItem-loadScenarioItem scenarioInputs path = do+  m (ScenarioItem ScenarioInfo)+loadScenarioItem scenarioInputs loadTestScenarios path = do   isDir <- sendIO $ doesDirectoryExist path   let collectionName = into @Text . dropWhile isSpace . takeBaseName $ path   case isDir of-    True -> SICollection collectionName <$> loadScenarioDir scenarioInputs path+    True -> SICollection collectionName <$> loadScenarioDir scenarioInputs loadTestScenarios path     False -> do       s <- loadScenarioFile scenarioInputs path       eitherSi <- runThrow @SystemFailure (loadScenarioInfo path)       case eitherSi of-        Right si -> return $ SISingle (s, si)+        Right si -> return $ SISingle $ ScenarioWith s si         Left warning -> do           warn warning-          return $ SISingle (s, ScenarioInfo path NotStarted)+          return . SISingle . ScenarioWith s $ ScenarioInfo path NotStarted  ------------------------------------------------------------ -- Some lenses + prisms
src/swarm-engine/Swarm/Game/State.hs view
@@ -15,6 +15,7 @@   creativeMode,   winCondition,   winSolution,+  completionStatsSaved,    -- ** Launch parameters   LaunchParams,@@ -35,6 +36,8 @@   -- ** GameState initialization   initGameState,   CodeToRun (..),+  toRunSource,+  toRunSyntax,   Sha1 (..),   SolutionSource (..),   parseCodeFile,@@ -64,6 +67,7 @@   genMultiWorld,   genRobotTemplates,   entityAt,+  mtlEntityAt,   contentAt,   zoomWorld,   zoomRobots,@@ -76,6 +80,7 @@ import Control.Effect.Throw import Control.Lens hiding (Const, use, uses, view, (%=), (+=), (.=), (<+=), (<<.=)) import Control.Monad (forM, join)+import Control.Monad.Trans.State.Strict qualified as TS import Data.Aeson (ToJSON) import Data.Digest.Pure.SHA (sha1, showDigest) import Data.Foldable (toList)@@ -85,6 +90,7 @@ import Data.IntSet qualified as IS import Data.Map qualified as M import Data.Maybe (fromMaybe, mapMaybe)+import Data.MonoidMap qualified as MM import Data.Sequence (Seq ((:<|))) import Data.Sequence qualified as Seq import Data.Text (Text)@@ -92,15 +98,17 @@ import Data.Text.IO qualified as TIO import Data.Text.Lazy qualified as TL import Data.Text.Lazy.Encoding qualified as TL+import Data.Tuple (swap) import GHC.Generics (Generic)+import Swarm.Failure (SystemFailure (..)) import Swarm.Game.CESK (Store, emptyStore, store, suspendedEnv) import Swarm.Game.Entity-import Swarm.Game.Failure (SystemFailure (..)) import Swarm.Game.Land import Swarm.Game.Location import Swarm.Game.Robot import Swarm.Game.Robot.Concrete import Swarm.Game.Scenario.Status+import Swarm.Game.State.Config import Swarm.Game.State.Landscape import Swarm.Game.State.Robot import Swarm.Game.State.Substate@@ -114,7 +122,7 @@ import Swarm.Language.Syntax (SrcLoc (..), TSyntax, sLoc) import Swarm.Language.Value (Env) import Swarm.Log-import Swarm.Util (uniq)+import Swarm.Util (applyWhen, uniq) import Swarm.Util.Lens (makeLensesNoSigs)  newtype Sha1 = Sha1 String@@ -127,8 +135,13 @@     -- on a leaderboard.     PlayerAuthored FilePath Sha1 -data CodeToRun = CodeToRun SolutionSource TSyntax+data CodeToRun = CodeToRun+  { _toRunSource :: SolutionSource+  , _toRunSyntax :: TSyntax+  } +makeLenses ''CodeToRun+ getRunCodePath :: CodeToRun -> Maybe FilePath getRunCodePath (CodeToRun solutionSource _) = case solutionSource of   ScenarioSuggested -> Nothing@@ -159,6 +172,22 @@ -- | The main record holding the state for the game itself (as --   distinct from the UI).  See the lenses below for access to its --   fields.+--+--   To answer the question of what belongs in the `GameState` and+--   what belongs in the `UIState`, ask yourself the question: is this+--   something specific to a particular UI, or is it something+--   inherent to the game which would be needed even if we put a+--   different UI on top (web-based, GUI-based, etc.)? For example,+--   tracking whether the game is paused needs to be in the+--   `GameState`: especially if we want to have the game running in+--   one thread and the UI running in another thread, then the game+--   itself needs to keep track of whether it is currently paused, so+--   that it can know whether to step independently of the UI telling+--   it so. For example, the game may run for several ticks during a+--   single frame, but if an objective is completed during one of+--   those ticks, the game needs to immediately auto-pause without+--   waiting for the UI to tell it that it should do so, which could+--   come several ticks late. data GameState = GameState   { _creativeMode :: Bool   , _temporal :: TemporalState@@ -169,11 +198,12 @@   , _discovery :: Discovery   , _randomness :: Randomness   , _recipesInfo :: Recipes-  , _currentScenarioPath :: Maybe FilePath+  , _currentScenarioPath :: Maybe ScenarioPath   , _landscape :: Landscape   , _needsRedraw :: Bool   , _gameControls :: GameControls   , _messageInfo :: Messages+  , _completionStatsSaved :: Bool   }  makeLensesNoSigs ''GameState@@ -199,9 +229,9 @@ robotsAtLocation :: Cosmic Location -> GameState -> [Robot] robotsAtLocation loc gs =   mapMaybe (`IM.lookup` (gs ^. robotInfo . robotMap))-    . maybe [] IS.toList-    . M.lookup (loc ^. planar)-    . M.findWithDefault mempty (loc ^. subworld)+    . IS.toList+    . MM.get (loc ^. planar)+    . MM.get (loc ^. subworld)     . view (robotInfo . robotsByLocation)     $ gs @@ -211,14 +241,15 @@ -- | Get all the robots within a given Manhattan distance from a --   location. robotsInArea :: Cosmic Location -> Int32 -> Robots -> [Robot]-robotsInArea (Cosmic subworldName o) d rs = map (rm IM.!) rids+robotsInArea (Cosmic subworldName o) d rs = mapMaybe (rm IM.!?) rids  where   rm = rs ^. robotMap   rl = rs ^. robotsByLocation   rids =-    concatMap IS.elems $-      getElemsInArea o d $-        M.findWithDefault mempty subworldName rl+    concatMap IS.elems+      . getElemsInArea o d+      . MM.toMap+      $ MM.get subworldName rl  -- | The base robot, if it exists. baseRobot :: Traversal' GameState Robot@@ -247,7 +278,16 @@ -- -- This is useful as an index to the scenarios collection, -- see 'Swarm.Game.ScenarioInfo.scenarioItemByPath'.-currentScenarioPath :: Lens' GameState (Maybe FilePath)+--+-- Note that it is possible for this to be missing even+-- with an active game state, since the game state can+-- be initialized from sources other than a scenario+-- file on disk.+--+-- We keep a reference to the possible path within the GameState,+-- however, so that the achievement/progress saving functions+-- do not require access to anything outside GameState.+currentScenarioPath :: Lens' GameState (Maybe ScenarioPath)  -- | Info about the lay of the land landscape :: Lens' GameState Landscape@@ -264,6 +304,17 @@ -- | Message info messageInfo :: Lens' GameState Messages +-- | Whether statistics for the current scenario have been saved to+--   disk *upon scenario completion*. (It should remain False whenever+--   the current scenario has not been completed, either because there+--   is no win condition or because the player has not yet achieved+--   it.)  If this is set to True, we should not update completion+--   statistics any more.  We need this to make sure we don't+--   overwrite statistics if the user continues playing the scenario+--   after completing it (or even if the user stays in the completion+--   menu for a while before quitting; see #1932).+completionStatsSaved :: Lens' GameState Bool+ ------------------------------------------------------------ -- Utilities ------------------------------------------------------------@@ -283,7 +334,7 @@     new = takeWhile (\l -> l ^. leTime > gs ^. messageInfo . lastSeenMessageTime) $ reverse allUniq     -- creative players and system robots just see all messages (and focused robots logs)     unchecked = gs ^. creativeMode || fromMaybe False (focusedRobot gs ^? _Just . systemRobot)-    messages = (if unchecked then id else focusedOrLatestClose) (gs ^. messageInfo . messageQueue)+    messages = applyWhen (not unchecked) focusedOrLatestClose (gs ^. messageInfo . messageQueue)     allMessages = Seq.sort $ focusedLogs <> messages     focusedLogs = maybe Empty (view robotLog) (focusedRobot gs)     -- classic players only get to see messages that they said and a one message that they just heard@@ -321,7 +372,7 @@ recalcViewCenterAndRedraw g =   g     & robotInfo .~ newRobotInfo-    & (if ((/=) `on` (^. viewCenter)) oldRobotInfo newRobotInfo then needsRedraw .~ True else id)+    & applyWhen (((/=) `on` (^. viewCenter)) oldRobotInfo newRobotInfo) (needsRedraw .~ True)  where   oldRobotInfo = g ^. robotInfo   newRobotInfo = recalcViewCenter oldRobotInfo@@ -450,7 +501,9 @@ initGameState gsc =   GameState     { _creativeMode = False-    , _temporal = initTemporalState+    , _temporal =+        initTemporalState (startPaused gsc)+          & pauseOnObjective .~ (if pauseOnObjectiveCompletion gsc then PauseOnAnyObjective else PauseOnWin)     , _winCondition = NoWinCondition     , _winSolution = Nothing     , _robotInfo = initRobots gsc@@ -463,7 +516,17 @@     , _needsRedraw = False     , _gameControls = initGameControls     , _messageInfo = initMessages+    , _completionStatsSaved = False     }++-- | Provide an entity accessor via the MTL transformer State API.+-- This is useful for the structure recognizer.+mtlEntityAt :: Cosmic Location -> TS.State GameState (Maybe Entity)+mtlEntityAt = TS.state . runGetEntity+ where+  runGetEntity :: Cosmic Location -> GameState -> (Maybe Entity, GameState)+  runGetEntity loc gs =+    swap . run . Fused.runState gs $ entityAt loc  -- | Get the entity (if any) at a given location. entityAt :: (Has (State GameState) sig m) => Cosmic Location -> m (Maybe Entity)
src/swarm-engine/Swarm/Game/State/Initialize.hs view
@@ -1,3 +1,4 @@+-- | -- SPDX-License-Identifier: BSD-3-Clause -- Description: Game-related state and utilities --@@ -11,10 +12,8 @@ import Control.Arrow (Arrow ((&&&))) import Control.Carrier.State.Lazy qualified as Fused import Control.Effect.Lens (view)-import Control.Effect.Lift (Has)-import Control.Effect.State (State)-import Control.Lens hiding (Const, use, uses, view, (%=), (+=), (.=), (<+=), (<<.=))-import Data.Foldable.Extra (allM)+import Control.Lens hiding (view)+import Data.Hashable (Hashable) import Data.IntMap qualified as IM import Data.List (partition) import Data.List.NonEmpty (NonEmpty)@@ -24,7 +23,7 @@ import Data.Maybe (isNothing) import Data.Set qualified as S import Data.Text (Text)-import Linear (V2 (..))+import Data.Tuple.Extra (dupe) import Swarm.Game.CESK (finalValue, initMachine) import Swarm.Game.Device (getCapabilitySet, getMap) import Swarm.Game.Entity@@ -34,6 +33,7 @@   inRecipeMap,   outRecipeMap,  )+import Swarm.Game.Recipe.Graph qualified as RG import Swarm.Game.Robot import Swarm.Game.Robot.Concrete import Swarm.Game.Scenario@@ -42,52 +42,59 @@ import Swarm.Game.Scenario.Topography.Structure.Recognition import Swarm.Game.Scenario.Topography.Structure.Recognition.Log import Swarm.Game.Scenario.Topography.Structure.Recognition.Precompute+import Swarm.Game.Scenario.Topography.Structure.Recognition.Registry (emptyFoundStructures) import Swarm.Game.Scenario.Topography.Structure.Recognition.Type import Swarm.Game.State import Swarm.Game.State.Landscape (mkLandscape) import Swarm.Game.State.Robot (setRobotInfo) import Swarm.Game.State.Substate-import Swarm.Game.Universe as U (offsetBy)+import Swarm.Game.Step.Util (adaptGameState) import Swarm.Game.World.Gen (Seed) import Swarm.Language.Capability (constCaps)-import Swarm.Language.Syntax (allConst)+import Swarm.Language.Syntax (allConst, erase) import Swarm.Language.Types-import Swarm.Util (binTuples, (?))+import Swarm.Util (applyWhen, binTuples, (?)) import System.Clock qualified as Clock import System.Random (mkStdGen)  -- | Create an initial game state corresponding to the given scenario. scenarioToGameState ::-  Scenario ->+  ScenarioWith (Maybe ScenarioPath) ->   ValidatedLaunchParams ->   GameStateConfig ->   IO GameState-scenarioToGameState scenario (LaunchParams (Identity userSeed) (Identity toRun)) gsc = do+scenarioToGameState si@(ScenarioWith scenario _) (LaunchParams (Identity userSeed) (Identity toRun)) gsc = do   theSeed <- arbitrateSeed userSeed $ scenario ^. scenarioLandscape   now <- Clock.getTime Clock.Monotonic-  return $ pureScenarioToGameState scenario theSeed now toRun gsc+  return $ pureScenarioToGameState si theSeed now toRun gsc  pureScenarioToGameState ::-  Scenario ->+  ScenarioWith (Maybe ScenarioPath) ->   Seed ->   Clock.TimeSpec ->   Maybe CodeToRun ->   GameStateConfig ->   GameState-pureScenarioToGameState scenario theSeed now toRun gsc =+pureScenarioToGameState (ScenarioWith scenario fp) theSeed now toRun gsc =   preliminaryGameState-    & discovery . structureRecognition .~ recognizer+    & discovery . structureRecognition .~ recognition  where   sLandscape = scenario ^. scenarioLandscape -  recognizer =-    runIdentity $-      Fused.evalState preliminaryGameState $-        mkRecognizer (sLandscape ^. scenarioStructures)+  -- It may be possible at some point for the game seed to affect whether+  -- initially-placed structures remain intact, by way of random placements.+  -- Therefore we run this at 'GameState' initialization time, rather than+  -- 'Scenario' parse time.+  recognition =+    runIdentity+      . Fused.evalState preliminaryGameState+      . adaptGameState+      $ initializeRecognition mtlEntityAt (sLandscape ^. scenarioStructures)    gs = initGameState gsc   preliminaryGameState =     gs+      & currentScenarioPath .~ fp       & robotInfo %~ setRobotInfo baseID robotList'       & creativeMode .~ scenario ^. scenarioOperation . scenarioCreative       & winCondition .~ theWinCondition@@ -95,11 +102,12 @@       & discovery . availableCommands .~ Notifications 0 False initialCommands       & discovery . knownEntities .~ sLandscape ^. scenarioKnown       & discovery . tagMembers .~ buildTagMap em+      & discovery . craftableDevices .~ craftable       & randomness . seed .~ theSeed       & randomness . randGen .~ mkStdGen theSeed       & recipesInfo %~ modifyRecipesInfo       & landscape .~ mkLandscape sLandscape worldTuples theSeed-      & gameControls . initiallyRunCode .~ initialCodeToRun+      & gameControls . initiallyRunCode .~ (erase <$> initialCodeToRun)       & gameControls . replStatus .~ case running of -- When the base starts out running a program, the REPL status must be set to working,       -- otherwise the store of definition cells is not saved (see #333, #838)         False -> REPLDone Nothing@@ -108,6 +116,15 @@    robotList' = (robotCreatedAt .~ now) <$> robotList +  -- Get the names of all devices (i.e. entities that provide at least+  -- one capability) which can be recursively crafted from the+  -- starting inventory + entities available in the world+  craftable = S.map (view entityName) . S.filter isDevice $ S.unions (RG.levels recipeGraph)+   where+    recipeGraph = RG.scenarioRecipeGraph scenario (initState gsc)+    isDevice :: Entity -> Bool+    isDevice = not . M.null . getMap . view entityCapabilities+   modifyRecipesInfo oldRecipesInfo =     oldRecipesInfo       & recipesOut %~ addRecipesWith outRecipeMap@@ -118,11 +135,9 @@   baseID = 0   (things, devices) = partition (M.null . getMap . view entityCapabilities) (M.elems (entitiesByName em)) -  getCodeToRun (CodeToRun _ s) = s-   robotsByBasePrecedence = genRobotTemplates sLandscape worldTuples -  initialCodeToRun = getCodeToRun <$> toRun+  initialCodeToRun = view toRunSyntax <$> toRun    robotListRaw =     zipWith (instantiateRobot Nothing) [baseID ..] robotsByBasePrecedence@@ -142,14 +157,14 @@       -- If we are in creative mode, give base all the things       & ix baseID         . robotInventory-        %~ case scenario ^. scenarioOperation . scenarioCreative of-          False -> id-          True -> union (fromElems (map (0,) things))+        %~ applyWhen+          (scenario ^. scenarioOperation . scenarioCreative)+          (union (fromElems (map (0,) things)))       & ix baseID         . equippedDevices-        %~ case scenario ^. scenarioOperation . scenarioCreative of-          False -> id-          True -> const (fromList devices)+        %~ applyWhen+          (scenario ^. scenarioOperation . scenarioCreative)+          (const (fromList devices))    running = case robotList of     [] -> False@@ -177,43 +192,34 @@    addRecipesWith f = IM.unionWith (<>) (f $ scenario ^. scenarioOperation . scenarioRecipes) -mkRecognizer ::-  (Has (State GameState) sig m) =>-  StaticStructureInfo ->-  m (StructureRecognizer StructureCells Entity)-mkRecognizer structInfo@(StaticStructureInfo structDefs _) = do-  foundIntact <- mapM (sequenceA . (id &&& ensureStructureIntact)) allPlaced-  let fs = populateStaticFoundStructures . map fst . filter snd $ foundIntact+-- |+-- As part of initializing the recognizer, we also pre-populate the+-- list of "found" structures with those statically placed by the scenario definition.+-- Note that this bypasses the regular "online" recognition machinery;+-- we don't actually have to "search" for these structures since we are+-- explicitly given their location; we only need to validate that each+-- structure remains intact given other, potentially overlapping static placements.+initializeRecognition ::+  (Monad s, Hashable a, Eq b) =>+  GenericEntLocator s a ->+  StaticStructureInfo b a ->+  s (RecognitionState b a)+initializeRecognition entLoader structInfo = do+  foundIntact <- mapM checkIntactness allPlaced++  let fs = populateStaticFoundStructures . map fst . filter (null . snd) $ foundIntact   return $-    StructureRecognizer-      (mkAutomatons structDefs)+    RecognitionState       fs       [IntactStaticPlacement $ map mkLogEntry foundIntact]  where+  checkIntactness = traverse (ensureStructureIntact emptyFoundStructures entLoader) . dupe+   allPlaced = lookupStaticPlacements structInfo   mkLogEntry (x, intact) =     IntactPlacementLog       intact-      ((getName . originalDefinition . structureWithGrid) x)-      (upperLeftCorner x)---- | Matches definitions against the placements.--- Fails fast (short-circuits) if a non-matching--- cell is encountered.-ensureStructureIntact ::-  (Has (State GameState) sig m) =>-  FoundStructure StructureCells Entity ->-  m Bool-ensureStructureIntact (FoundStructure (StructureWithGrid _ _ grid) upperLeft) =-  allM outer $ zip [0 ..] grid- where-  outer (y, row) = allM (inner y) $ zip [0 ..] row-  inner y (x, maybeTemplateEntity) = case maybeTemplateEntity of-    Nothing -> return True-    Just _ ->-      fmap (== maybeTemplateEntity) $-        entityAt $-          upperLeft `offsetBy` V2 x (negate y)+      $ PositionedStructure (upperLeftCorner x) ((distillLabel . structureWithGrid) x)  buildTagMap :: EntityMap -> Map Text (NonEmpty EntityName) buildTagMap em =
src/swarm-engine/Swarm/Game/State/Robot.hs view
@@ -62,22 +62,20 @@ import Data.IntSet qualified as IS import Data.IntSet.Lens (setOf) import Data.List (partition)-import Data.List.NonEmpty qualified as NE-import Data.Map (Map)-import Data.Map qualified as M import Data.Maybe (fromMaybe, mapMaybe)+import Data.MonoidMap (MonoidMap)+import Data.MonoidMap qualified as MM import Data.Set qualified as S-import Data.Tuple (swap) import GHC.Generics (Generic) import Swarm.Game.CESK (CESK (Waiting)) import Swarm.Game.Location-import Swarm.Game.ResourceLoading (NameGenerator) import Swarm.Game.Robot import Swarm.Game.Robot.Concrete import Swarm.Game.State.Config import Swarm.Game.Tick import Swarm.Game.Universe as U-import Swarm.Util (binTuples, surfaceEmpty, (<+=), (<<.=))+import Swarm.ResourceLoading (NameGenerator)+import Swarm.Util ((<+=), (<<.=)) import Swarm.Util.Lens (makeLensesExcluding)  -- | The 'ViewCenterRule' specifies how to determine the center of the@@ -120,13 +118,13 @@     -- 'wakeUpRobotsDoneSleeping'.     -- Waiting robots for a given time are a list because it is cheaper to     -- prepend to a list than insert into a 'Set'.-    _waitingRobots :: Map TickNumber [RID]+    _waitingRobots :: MonoidMap TickNumber [RID]   , _currentTickWakeableBots :: [RID]-  , _robotsByLocation :: Map SubworldName (Map Location IntSet)+  , _robotsByLocation :: MonoidMap SubworldName (MonoidMap Location IntSet)   , -- This member exists as an optimization so     -- that we do not have to iterate over all "waiting" robots,     -- since there may be many.-    _robotsWatching :: Map (Cosmic Location) IntSet+    _robotsWatching :: MonoidMap (Cosmic Location) IntSet   , _robotNaming :: RobotNaming   , _viewCenterRule :: ViewCenterRule   , _viewCenter :: Cosmic Location@@ -153,7 +151,7 @@ -- | The names of the robots that are currently sleeping, indexed by wake up --   time. Note that this may not include all sleeping robots, particularly --   those that are only taking a short nap (e.g. @wait 1@).-waitingRobots :: Getter Robots (Map TickNumber [RID])+waitingRobots :: Getter Robots (MonoidMap TickNumber [RID]) waitingRobots = internalWaitingRobots  -- | Get a list of all the robots that are \"watching\" by location.@@ -168,10 +166,10 @@ --   location of a robot changes, or a robot is created or destroyed. --   Fortunately, there are relatively few ways for these things to --   happen.-robotsByLocation :: Lens' Robots (Map SubworldName (Map Location IntSet))+robotsByLocation :: Lens' Robots (MonoidMap SubworldName (MonoidMap Location IntSet))  -- | Get a list of all the robots that are \"watching\" by location.-robotsWatching :: Lens' Robots (Map (Cosmic Location) IntSet)+robotsWatching :: Lens' Robots (MonoidMap (Cosmic Location) IntSet)  -- | State and data for assigning identifiers to robots robotNaming :: Lens' Robots RobotNaming@@ -200,9 +198,9 @@   Robots     { _robotMap = IM.empty     , _activeRobots = IS.empty-    , _waitingRobots = M.empty+    , _waitingRobots = mempty     , _currentTickWakeableBots = mempty-    , _robotsByLocation = M.empty+    , _robotsByLocation = mempty     , _robotsWatching = mempty     , _robotNaming =         RobotNaming@@ -267,17 +265,14 @@ addRobotToLocation :: (Has (State Robots) sig m) => RID -> Cosmic Location -> m () addRobotToLocation rid rLoc =   robotsByLocation-    %= M.insertWith-      (M.unionWith IS.union)-      (rLoc ^. subworld)-      (M.singleton (rLoc ^. planar) (IS.singleton rid))+    %= MM.adjust (MM.adjust (IS.insert rid) (rLoc ^. planar)) (rLoc ^. subworld)  -- | Takes a robot out of the 'activeRobots' set and puts it in the 'waitingRobots' --   queue. sleepUntil :: (Has (State Robots) sig m) => RID -> TickNumber -> m () sleepUntil rid time = do   internalActiveRobots %= IS.delete rid-  internalWaitingRobots . at time . non [] %= (rid :)+  internalWaitingRobots %= MM.adjust (rid :) time  -- | Takes a robot out of the 'activeRobots' set. sleepForever :: (Has (State Robots) sig m) => RID -> m ()@@ -301,22 +296,18 @@ -- * 'internalActiveRobots' (aka 'activeRobots') wakeUpRobotsDoneSleeping :: (Has (State Robots) sig m) => TickNumber -> m () wakeUpRobotsDoneSleeping time = do-  mrids <- internalWaitingRobots . at time <<.= Nothing-  case mrids of-    Nothing -> return ()-    Just rids -> do-      robots <- use robotMap-      let robotIdSet = IM.keysSet robots-          wakeableRIDsSet = IS.fromList rids+  robotIdSet <- IM.keysSet <$> use robotMap+  wakeableRIDsSet <- IS.fromList . MM.get time <$> use internalWaitingRobots+  internalWaitingRobots %= MM.nullify time -          -- Limit ourselves to the robots that have not expired in their sleep-          newlyAlive = IS.intersection robotIdSet wakeableRIDsSet+  -- Limit ourselves to the robots that have not expired in their sleep+  let newlyAlive = IS.intersection robotIdSet wakeableRIDsSet -      internalActiveRobots %= IS.union newlyAlive+  internalActiveRobots %= IS.union newlyAlive -      -- These robots' wake times may have been moved "forward"-      -- by 'wakeWatchingRobots'.-      clearWatchingRobots wakeableRIDsSet+  -- These robots' wake times may have been moved "forward"+  -- by 'wakeWatchingRobots'.+  clearWatchingRobots wakeableRIDsSet  -- | Clear the "watch" state of all of the -- awakened robots@@ -325,7 +316,7 @@   IntSet ->   m () clearWatchingRobots rids = do-  robotsWatching %= M.map (`IS.difference` rids)+  robotsWatching %= MM.map (`IS.difference` rids)  -- | Iterates through all of the currently @wait@-ing robots, -- and moves forward the wake time of the ones that are @watch@-ing this location.@@ -346,25 +337,22 @@       botsWatchingThisLoc =         mapMaybe (`IM.lookup` rMap) $           IS.toList $-            M.findWithDefault mempty loc watchingMap+            MM.get loc watchingMap        -- Step 2: Get the target wake time for each of these robots       wakeTimes :: [(RID, TickNumber)]       wakeTimes = mapMaybe (sequenceA . (view robotID &&& waitingUntil)) botsWatchingThisLoc -      wakeTimesToPurge :: Map TickNumber (S.Set RID)-      wakeTimesToPurge = M.fromListWith (<>) $ map (fmap S.singleton . swap) wakeTimes+      wakeTimesToPurge :: MonoidMap TickNumber (S.Set RID)+      wakeTimesToPurge = foldr (uncurry (MM.adjust . S.insert)) mempty wakeTimes        -- Step 3: Take these robots out of their time-indexed slot in "waitingRobots".       -- To preserve performance, this should be done without iterating over the       -- entire "waitingRobots" map.-      filteredWaiting = foldr f waitingMap $ M.toList wakeTimesToPurge+      filteredWaiting :: MonoidMap TickNumber [RID]+      filteredWaiting = MM.foldrWithKey f waitingMap wakeTimesToPurge        where-        -- Note: some of the map values may become empty lists.-        -- But we shall not worry about cleaning those up here;-        -- they will be "garbage collected" as a matter of course-        -- when their tick comes up in "wakeUpRobotsDoneSleeping".-        f (k, botsToRemove) = M.adjust (filter (`S.notMember` botsToRemove)) k+        f k botsToRemove = MM.adjust (filter (`S.notMember` botsToRemove)) k        -- Step 4: Re-add the watching bots to be awakened ASAP:       wakeableBotIds = map fst wakeTimes@@ -378,7 +366,7 @@         [ (currentTick, currTickWakeable)         , (addTicks 1 currentTick, nextTickWakeable)         ]-      newInsertions = M.filter (not . null) $ M.fromList wakeTimeGroups+      newInsertions = MM.fromList wakeTimeGroups    -- Contract: This must be emptied immediately   -- in 'iterateRobots'@@ -389,7 +377,7 @@   -- 2. In each robot, via the CESK machine state    -- 1. Update the game state-  internalWaitingRobots .= M.unionWith (<>) filteredWaiting newInsertions+  internalWaitingRobots .= filteredWaiting <> newInsertions    -- 2. Update the machine of each robot   forM_ wakeTimeGroups $ \(newWakeTime, wakeableBots) ->@@ -416,12 +404,8 @@   RID ->   m () removeRobotFromLocationMap (Cosmic oldSubworld oldPlanar) rid =-  robotsByLocation %= M.update (tidyDelete rid) oldSubworld- where-  deleteOne x = surfaceEmpty IS.null . IS.delete x--  tidyDelete robID =-    surfaceEmpty M.null . M.update (deleteOne robID) oldPlanar+  robotsByLocation+    %= MM.adjust (MM.adjust (IS.delete rid) oldPlanar) oldSubworld  setRobotInfo :: RID -> [Robot] -> Robots -> Robots setRobotInfo baseID robotList rState =@@ -432,19 +416,16 @@ setRobotList robotList rState =   rState     & robotMap .~ IM.fromList (map (view robotID &&& id) robotList)-    & robotsByLocation .~ M.map (groupRobotsByPlanarLocation . NE.toList) (groupRobotsBySubworld robotList)+    & robotsByLocation .~ groupRobotsByLocation robotList     & internalActiveRobots .~ setOf (traverse . robotID) robotList     & robotNaming . gensym .~ initGensym  where   initGensym = length robotList - 1 -  groupRobotsBySubworld =-    binTuples . map (view (robotLocation . subworld) &&& id)--  groupRobotsByPlanarLocation rs =-    M.fromListWith-      IS.union-      (map (view (robotLocation . planar) &&& (IS.singleton . view robotID)) rs)+  groupRobotsByLocation = foldr f mempty+   where+    f r = MM.adjust (g r) (r ^. (robotLocation . subworld))+    g r = MM.adjust (IS.insert (r ^. robotID)) (r ^. (robotLocation . planar))  -- | Modify the 'viewCenter' by applying an arbitrary function to the --   current value.  Note that this also modifies the 'viewCenterRule'
src/swarm-engine/Swarm/Game/State/Runtime.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TemplateHaskell #-}  -- |@@ -6,18 +8,18 @@ -- Runtime state and utility functions module Swarm.Game.State.Runtime (   RuntimeState,+  RuntimeOptions (..),+  initRuntimeState,    -- ** Lenses   webPort,   upstreamRelease,   eventLog,-  scenarios,   appData,   stdGameConfigInputs,    -- ** Utility   initScenarioInputs,-  initRuntimeState,   initGameStateConfig, ) where@@ -29,24 +31,20 @@ import Data.Map (Map) import Data.Sequence (Seq) import Data.Text (Text)-import Network.Wai.Handler.Warp (Port)-import Swarm.Game.Failure (SystemFailure)+import Swarm.Failure (SystemFailure) import Swarm.Game.Land import Swarm.Game.Recipe (loadRecipes)-import Swarm.Game.ResourceLoading (initNameGenerator, readAppData) import Swarm.Game.Scenario (GameStateInputs (..), ScenarioInputs (..))-import Swarm.Game.ScenarioInfo (ScenarioCollection, loadScenarios) import Swarm.Game.State.Substate import Swarm.Game.World.Load (loadWorlds) import Swarm.Log+import Swarm.ResourceLoading (initNameGenerator, readAppData) import Swarm.Util.Lens (makeLensesNoSigs)-import Swarm.Version (NewReleaseFailure (..))  data RuntimeState = RuntimeState-  { _webPort :: Maybe Port-  , _upstreamRelease :: Either NewReleaseFailure String+  { _webPort :: Maybe Int+  , _upstreamRelease :: Either (Severity, Text) String   , _eventLog :: Notifications LogEntry-  , _scenarios :: ScenarioCollection   , _stdGameConfigInputs :: GameStateConfig   , _appData :: Map Text Text   }@@ -78,29 +76,36 @@   , Has (Accum (Seq SystemFailure)) sig m   , Has (Lift IO) sig m   ) =>+  RuntimeOptions ->   m GameStateConfig-initGameStateConfig = do-  gsi <- initGameStateInputs-  appDataMap <- readAppData-  nameGen <- initNameGenerator appDataMap-  return $ GameStateConfig appDataMap nameGen gsi+initGameStateConfig RuntimeOptions {..} = do+  initAppDataMap <- readAppData+  nameParts <- initNameGenerator initAppDataMap+  initState <- initGameStateInputs+  return $ GameStateConfig {..} +-- | Runtime state initialization options.+data RuntimeOptions = RuntimeOptions+  { startPaused :: Bool+  , pauseOnObjectiveCompletion :: Bool+  , loadTestScenarios :: Bool+  }+  deriving (Eq, Show)+ initRuntimeState ::   ( Has (Throw SystemFailure) sig m   , Has (Accum (Seq SystemFailure)) sig m   , Has (Lift IO) sig m   ) =>+  RuntimeOptions ->   m RuntimeState-initRuntimeState = do-  gsc <- initGameStateConfig-  scenarios <- loadScenarios $ gsiScenarioInputs $ initState gsc-+initRuntimeState opts = do+  gsc <- initGameStateConfig opts   return $     RuntimeState       { _webPort = Nothing-      , _upstreamRelease = Left (NoMainUpstreamRelease [])+      , _upstreamRelease = Left (Info, "No upstream release found.")       , _eventLog = mempty-      , _scenarios = scenarios       , _appData = initAppDataMap gsc       , _stdGameConfigInputs = gsc       }@@ -108,10 +113,10 @@ makeLensesNoSigs ''RuntimeState  -- | The port on which the HTTP debug service is running.-webPort :: Lens' RuntimeState (Maybe Port)+webPort :: Lens' RuntimeState (Maybe Int)  -- | The upstream release version.-upstreamRelease :: Lens' RuntimeState (Either NewReleaseFailure String)+upstreamRelease :: Lens' RuntimeState (Either (Severity, Text) String)  -- | A log of runtime events. --@@ -119,9 +124,6 @@ -- If some error happens before a game is even selected, this is the -- place to log it. eventLog :: Lens' RuntimeState (Notifications LogEntry)---- | The collection of scenarios that comes with the game.-scenarios :: Lens' RuntimeState ScenarioCollection  -- | Built-in resources for loading games stdGameConfigInputs :: Lens' RuntimeState GameStateConfig
src/swarm-engine/Swarm/Game/State/Substate.hs view
@@ -27,12 +27,14 @@    -- *** Temporal state   TemporalState,+  PauseOnObjective (..),   initTemporalState,   gameStep,   runStatus,   ticks,   robotStepsPerTick,   paused,+  pauseOnObjective,    -- *** Recipes   Recipes,@@ -54,6 +56,7 @@   initiallyRunCode,   replStatus,   replNextValueIndex,+  replListener,   inputHandler,    -- *** Discovery@@ -63,6 +66,7 @@   availableRecipes,   availableCommands,   knownEntities,+  craftableDevices,   gameAchievements,   structureRecognition,   tagMembers,@@ -101,15 +105,14 @@   outRecipeMap,  ) import Swarm.Game.Robot-import Swarm.Game.Scenario (GameStateInputs (..), StructureCells)+import Swarm.Game.Scenario (GameStateInputs (..), RecognizableStructureContent) import Swarm.Game.Scenario.Objective import Swarm.Game.Scenario.Topography.Structure.Recognition import Swarm.Game.Scenario.Topography.Structure.Recognition.Registry (emptyFoundStructures)-import Swarm.Game.Scenario.Topography.Structure.Recognition.Type (RecognizerAutomatons (..)) import Swarm.Game.State.Config import Swarm.Game.Tick (TickNumber (..)) import Swarm.Game.World.Gen (Seed)-import Swarm.Language.Syntax (Const, TSyntax)+import Swarm.Language.Syntax (Const, Syntax) import Swarm.Language.Types (Polytype) import Swarm.Language.Value (Value) import Swarm.Log@@ -128,7 +131,7 @@     --   entered.  The @Maybe Value@ starts out as 'Nothing' and gets     --   filled in with a result once the command completes.     REPLWorking Polytype (Maybe Value)-  deriving (Eq, Show, Generic, FromJSON, ToJSON)+  deriving (Eq, Generic, ToJSON)  data WinStatus   = -- | There are one or more objectives remaining that the player@@ -144,7 +147,7 @@     -- The boolean indicates whether they have     -- already been informed.     Unwinnable Bool-  deriving (Show, Generic, FromJSON, ToJSON)+  deriving (Eq, Show, Generic, FromJSON, ToJSON)  data WinCondition   = -- | There is no winning condition.@@ -272,11 +275,15 @@ -- | Game step mode - we use the single step mode when debugging robot 'CESK' machine. data Step = WorldTick | RobotStep SingleStep +data PauseOnObjective = PauseOnWin | PauseOnAnyObjective+  deriving (Eq, Ord, Show, Enum, Bounded)+ data TemporalState = TemporalState   { _gameStep :: Step   , _runStatus :: RunStatus   , _ticks :: TickNumber   , _robotStepsPerTick :: Int+  , _pauseOnObjective :: PauseOnObjective   }  makeLensesNoSigs ''TemporalState@@ -298,11 +305,15 @@ --   a single tick. robotStepsPerTick :: Lens' TemporalState Int +-- | Whether to pause the game after an objective is completed.+pauseOnObjective :: Lens' TemporalState PauseOnObjective+ data GameControls = GameControls   { _replStatus :: REPLStatus   , _replNextValueIndex :: Integer+  , _replListener :: Text -> IO ()   , _inputHandler :: Maybe (Text, Value)-  , _initiallyRunCode :: Maybe TSyntax+  , _initiallyRunCode :: Maybe Syntax   }  makeLensesNoSigs ''GameControls@@ -313,20 +324,25 @@ -- | The index of the next @it{index}@ value replNextValueIndex :: Lens' GameControls Integer +-- | The action to be run after transitioning to REPLDone.+--   This is used to tell Web API the result of run command.+replListener :: Lens' GameControls (Text -> IO ())+ -- | The currently installed input handler and hint text. inputHandler :: Lens' GameControls (Maybe (Text, Value))  -- | Code that is run upon scenario start, before any -- REPL interaction.-initiallyRunCode :: Lens' GameControls (Maybe TSyntax)+initiallyRunCode :: Lens' GameControls (Maybe Syntax)  data Discovery = Discovery   { _allDiscoveredEntities :: Inventory   , _availableRecipes :: Notifications (Recipe Entity)   , _availableCommands :: Notifications Const   , _knownEntities :: S.Set EntityName+  , _craftableDevices :: S.Set EntityName   , _gameAchievements :: Map GameplayAchievement Attainment-  , _structureRecognition :: StructureRecognizer StructureCells Entity+  , _structureRecognition :: RecognitionState RecognizableStructureContent Entity   , _tagMembers :: Map Text (NonEmpty EntityName)   } @@ -345,11 +361,15 @@ --   robots know what they are without having to scan them. knownEntities :: Lens' Discovery (S.Set EntityName) +-- | The set of all entities that can be crafted in the current+--   scenario.+craftableDevices :: Lens' Discovery (S.Set EntityName)+ -- | Map of in-game achievements that were obtained gameAchievements :: Lens' Discovery (Map GameplayAchievement Attainment)  -- | Recognizer for robot-constructed structures-structureRecognition :: Lens' Discovery (StructureRecognizer StructureCells Entity)+structureRecognition :: Lens' Discovery (RecognitionState RecognizableStructureContent Entity)  -- | Map from tags to entities that possess that tag tagMembers :: Lens' Discovery (Map Text (NonEmpty EntityName))@@ -392,13 +412,14 @@  -- * Record initialization -initTemporalState :: TemporalState-initTemporalState =+initTemporalState :: Bool -> TemporalState+initTemporalState pausedAtStart =   TemporalState     { _gameStep = WorldTick-    , _runStatus = Running+    , _runStatus = if pausedAtStart then ManualPause else Running     , _ticks = TickNumber 0     , _robotStepsPerTick = defaultRobotStepsPerTick+    , _pauseOnObjective = PauseOnAnyObjective     }  initGameControls :: GameControls@@ -406,6 +427,7 @@   GameControls     { _replStatus = REPLDone Nothing     , _replNextValueIndex = 0+    , _replListener = const $ pure ()     , _inputHandler = Nothing     , _initiallyRunCode = Nothing     }@@ -425,10 +447,11 @@     , _availableCommands = mempty     , _allDiscoveredEntities = empty     , _knownEntities = mempty+    , _craftableDevices = mempty     , -- This does not need to be initialized with anything,       -- since the master list of achievements is stored in UIState       _gameAchievements = mempty-    , _structureRecognition = StructureRecognizer (RecognizerAutomatons mempty mempty) emptyFoundStructures []+    , _structureRecognition = RecognitionState emptyFoundStructures []     , _tagMembers = mempty     }
src/swarm-engine/Swarm/Game/Step.hs view
@@ -19,7 +19,6 @@ -- See <https://github.com/swarm-game/swarm/issues/495>. module Swarm.Game.Step where -import Control.Applicative (Applicative (..)) import Control.Carrier.Error.Either (ErrorC, runError) import Control.Carrier.State.Lazy import Control.Carrier.Throw.Either (runThrow)@@ -28,6 +27,7 @@ import Control.Effect.Lift import Control.Lens as Lens hiding (Const, distrib, from, parts, use, uses, view, (%=), (+=), (.=), (<+=), (<>=)) import Control.Monad (foldM, forM_, unless, when)+import Data.Foldable.Extra (notNull) import Data.Functor (void) import Data.IntMap qualified as IM import Data.IntSet qualified as IS@@ -64,17 +64,18 @@ import Swarm.Game.Step.Util.Command import Swarm.Game.Tick import Swarm.Language.Capability-import Swarm.Language.Pretty (BulletList (BulletList, bulletListItems), prettyText) import Swarm.Language.Requirements qualified as R import Swarm.Language.Syntax+import Swarm.Language.TDVar (tdVarName) import Swarm.Language.Typed (Typed (..)) import Swarm.Language.Value import Swarm.Log+import Swarm.Pretty (BulletList (BulletList, bulletListItems), prettyText) import Swarm.Util hiding (both) import Swarm.Util.WindowedCounter qualified as WC import System.Clock (TimeSpec) import Witch (From (from))-import Prelude hiding (Applicative (..), lookup)+import Prelude hiding (lookup)  -- | The main function to do one game tick. --@@ -100,15 +101,12 @@   -- also save the current store into the robotContext so we can   -- restore it the next time we start a computation.   mr <- use (robotInfo . robotMap . at 0)-  case mr of-    Just r -> do-      res <- use $ gameControls . replStatus-      case res of-        REPLWorking ty Nothing -> case getResult r of-          Just v -> gameControls . replStatus .= REPLWorking ty (Just v)-          Nothing -> pure ()-        _otherREPLStatus -> pure ()-    Nothing -> pure ()+  forM_ mr $ \r -> do+    res <- use $ gameControls . replStatus+    case res of+      REPLWorking ty Nothing -> forM_ (getResult r) $ \v ->+        gameControls . replStatus .= REPLWorking ty (Just v)+      _otherREPLStatus -> pure ()    -- Possibly update the view center.   modify recalcViewCenterAndRedraw@@ -338,8 +336,14 @@     Unwinnable _ -> grantAchievement LoseScenario     _ -> return () -  messageInfo . announcementQueue %= (>< Seq.fromList (map ObjectiveCompleted $ completionAnnouncementQueue finalAccumulator))+  queue <- messageInfo . announcementQueue Swarm.Util.<%= (>< Seq.fromList (map ObjectiveCompleted $ completionAnnouncementQueue finalAccumulator))+  shouldPause <- use $ temporal . pauseOnObjective +  let gameFinished = newWinState /= Ongoing+  let finishedObjectives = notNull queue+  when (finishedObjectives && (gameFinished || shouldPause == PauseOnAnyObjective)) $+    temporal . runStatus .= AutoPause+   mapM_ handleException $ exceptions finalAccumulator  where   getNextWinState ts completedObjs@@ -388,8 +392,6 @@         T.unwords           [ "Non boolean value:"           , prettyValue val-          , "real:"-          , T.pack (show val)           ]    -- Log exceptions in the message queue so we can check for them in tests@@ -554,14 +556,15 @@   In (TInt n) _ s k -> return $ Out (VInt n) s k   In (TText str) _ s k -> return $ Out (VText str) s k   In (TBool b) _ s k -> return $ Out (VBool b) s k+  In (TType ty) _ s k -> return $ Out (VType ty) s k   -- There should not be any antiquoted variables left at this point.   In (TAntiText v) _ s k ->     return $ Up (Fatal (T.append "Antiquoted variable found at runtime: $str:" v)) s k   In (TAntiInt v) _ s k ->     return $ Up (Fatal (T.append "Antiquoted variable found at runtime: $int:" v)) s k-  -- Require and requireDevice just turn into no-ops.-  In (TRequireDevice {}) e s k -> return $ In (TConst Noop) e s k+  -- Require and Stock just turn into no-ops.   In (TRequire {}) e s k -> return $ In (TConst Noop) e s k+  In (TStock {}) e s k -> return $ In (TConst Noop) e s k   In (TRequirements x t) e s k -> return $ Out (VRequirements x t e) s k   -- Type ascriptions are ignored   In (TAnnotate v _) e s k -> return $ In v e s k@@ -595,11 +598,40 @@   Out v2 s (FFst v1 : k) -> return $ Out (VPair v1 v2) s k   -- Lambdas immediately turn into closures.   In (TLam x _ t) e s k -> return $ Out (VClo x t e) s k+  -- Special case for evaluating an application of Instant or Atomic:+  -- set the runningAtomic flag and push a stack frame to unset it+  -- when done evaluating.  We do this here so that even /evaluating/+  -- the argument to instant/atomic will happen atomically (#2270).+  -- Execution will also happen atomically; that is handled in+  -- execConst.+  In (TApp (TConst c) t2) e s k+    | c `elem` [Atomic, Instant] -> do+        runningAtomic .= True+        case k of+          -- In the (common) special case that we will immediately+          -- execute the atomic/instant command next, don't bother+          -- pushing an FFinishAtomic frame. That way, runningAtomic+          -- will remain set, and evaluation + execution together will+          -- all happen in a single tick.+          FExec : _ -> return $ In t2 e s (FApp (VCApp c []) : k)+          -- Otherwise, in general, other evaluation may take place in+          -- between evaluating the argument to atomic/instant and+          -- executing it, so we must push an FFinishAtomic frame so+          -- that intermediate evaluation will not happen atomically.+          -- For example, consider something like `f (instant c)`,+          -- where `f : Cmd Unit -> Cmd Unit`.  After evaluating `c`+          -- atomically, `instant c` is then passed to `f`, which may+          -- do some (non-atomic) computation before executing its+          -- argument (if it is executed at all).+          _ -> return $ In t2 e s (FApp (VCApp c []) : FFinishAtomic : k)   -- To evaluate an application, start by focusing on the left-hand   -- side and saving the argument for later.   In (TApp t1 t2) e s k -> return $ In t1 e s (FArg t2 e : k)   -- Once that's done, switch to evaluating the argument.   Out v1 s (FArg t2 e : k) -> return $ In t2 e s (FApp v1 : k)+  -- Or, if there is an FVArg frame, the argument is already+  -- evaluated, so send it directly to an FApp.+  Out v1 s (FVArg v2 : k) -> return $ Out v2 s (FApp v1 : k)   -- We can evaluate an application of a closure in the usual way.   Out v2 s (FApp (VClo x t e) : k) -> return $ In t (addValueBinding x v2 e) s k   -- We can also evaluate an application of a constant by collecting@@ -633,10 +665,10 @@     _ -> badMachineState s "FProj frame with non-record value"   -- To evaluate non-recursive let expressions, we start by focusing on the   -- let-bound expression.-  In (TLet _ False x mty mreq t1 t2) e s k ->+  In (TLet _ False x _ mty mreq t1 t2) e s k ->     return $ In t1 e s (FLet x ((,) <$> mty <*> mreq) t2 e : k)   -- To evaluate a recursive let binding:-  In (TLet _ True x mty mreq t1 t2) e s k -> do+  In (TLet _ True x _ mty mreq t1 t2) e s k -> do     -- First, allocate a cell for it in the store with the initial     -- value of Blackhole.     let (loc, s') = allocate VBlackhole s@@ -654,7 +686,7 @@     return $ In t2 e' s k   -- To evaluate a tydef, insert it into the context and proceed to   -- evaluate the body.-  In (TTydef x _ tdInfo t1) e s k -> return $ In t1 (maybe id (addTydef x) tdInfo e) s k+  In (TTydef x _ tdInfo t1) e s k -> return $ In t1 (maybe id (addTydef (tdVarName x)) tdInfo e) s k   -- Bind expressions don't evaluate: just package it up as a value   -- until such time as it is to be executed.   In (TBind mx mty mreq t1 t2) e s k -> return $ Out (VBind mx mty mreq t1 t2 e) s k@@ -667,6 +699,8 @@   -- If we see a primitive application of suspend, package it up as   -- a value until it's time to execute.   In (TSuspend t) e s k -> return $ Out (VSuspend t e) s k+  -- Ignore explicit parens.+  In (TParens t) e s k -> return $ In t e s k   ------------------------------------------------------------   -- Execution @@ -830,7 +864,7 @@     --     -- HOWEVER, we have to make sure to check that the robot has the     -- 'log' capability which is required to collect and view logs.-    h <- hasCapability CLog+    h <- hasCapability $ CExecute Log     em <- use $ landscape . terrainAndEntities . entityMap     when h $ void $ traceLog RobotError (exnSeverity exn) (formatExn em exn)     return $ case menv of
src/swarm-engine/Swarm/Game/Step/Arithmetic.hs view
@@ -9,7 +9,6 @@ -- Arithmetic and Comparison commands module Swarm.Game.Step.Arithmetic where -import Control.Applicative (Applicative (..)) import Control.Carrier.State.Lazy import Control.Effect.Error import Control.Monad (zipWithM)@@ -21,7 +20,7 @@ import Swarm.Language.Syntax import Swarm.Language.Value import Witch (From (from))-import Prelude hiding (Applicative (..), lookup)+import Prelude hiding (lookup)  ------------------------------------------------------------ -- Comparison@@ -77,6 +76,7 @@   VSuspend {} -> incomparable v1   VExc {} -> incomparable v1   VBlackhole {} -> incomparable v1+  VType {} -> incomparable v1  -- | Values with different types were compared; this should not be --   possible since the type system should catch it.
src/swarm-engine/Swarm/Game/Step/Combustion.hs view
@@ -16,7 +16,6 @@ -- well as to initiate the delayed combustion of its neighbors. module Swarm.Game.Step.Combustion where -import Control.Applicative (Applicative (..)) import Control.Carrier.State.Lazy import Control.Effect.Lens import Control.Lens as Lens hiding (Const, distrib, from, parts, use, uses, view, (%=), (+=), (.=), (<+=), (<>=))@@ -46,7 +45,7 @@ import Swarm.Language.Text.Markdown qualified as Markdown import Swarm.Util hiding (both) import System.Clock (TimeSpec)-import Prelude hiding (Applicative (..), lookup)+import Prelude hiding (lookup)  igniteCommand :: (HasRobotStepState sig m, Has Effect.Time sig m) => Const -> Direction -> m () igniteCommand c d = do@@ -67,7 +66,11 @@   let selfCombustibility = (e ^. entityCombustion) ? defaultCombustibility   createdAt <- getNow   combustionDurationRand <- addCombustionBot e selfCombustibility createdAt loc-  forM_ (getNeighborLocs loc) $ igniteNeighbor createdAt combustionDurationRand+  let warmup = delay selfCombustibility+  let neighborAffectDuration = max 0 (combustionDurationRand - warmup)+  when (neighborAffectDuration > 0) $+    forM_ (getNeighborLocs loc) $+      igniteNeighbor createdAt warmup neighborAffectDuration  where   verb = "ignite"   verbed = "ignited"@@ -117,7 +120,7 @@       ts   return combustionDurationRand  where-  Combustibility _ durationRange maybeCombustionProduct = combustibility+  Combustibility _ durationRange _ maybeCombustionProduct = combustibility  -- | A system program for a "combustion robot", to burn an entity --   after it is ignited.@@ -141,7 +144,7 @@ --    cells. This would avoid polluting the logic of the currently burning cell --    with logic to manage probabilities of combustion propagation. combustionProgram :: Integer -> Combustibility -> TSyntax-combustionProgram combustionDuration (Combustibility _ _ maybeCombustionProduct) =+combustionProgram combustionDuration (Combustibility _ _ _ maybeCombustionProduct) =   [tmQ|     wait $int:combustionDuration;     if ($int:invQuantity > 0) {@@ -156,18 +159,25 @@     Nothing -> (0, "")     Just p -> (1, p) --- | We treat the 'ignition' field in the 'Combustibility' record--- as a /rate/ in a Poisson distribution.--- Ignition of neighbors depends on that particular neighbor entity's--- combustion /rate/, but also on the duration--- that the current entity will burn.+-- | Possibly ignite a neighbor of a source entity that is combusting.+--   @creationTime@ is the time the source entity began to combust.+--   @warmup@ is the number of ticks of delay that the source entity+--   needs to burn before it will start affecting its neighbors;+--   @sourceDuration@ is the number of ticks that it will potentially+--   affect its neighbors.+--+--   We treat the 'ignition' field in the 'Combustibility' record as a+--   /rate/ in a Poisson distribution.  Ignition of neighbors depends+--   on that particular neighbor entity's combustion /rate/, but also+--   on the @sourceDuration@ time that the current entity will burn. igniteNeighbor ::   Has (State GameState) sig m =>   TimeSpec ->   Integer ->+  Integer ->   Cosmic Location ->   m ()-igniteNeighbor creationTime sourceDuration loc = do+igniteNeighbor creationTime warmup sourceDuration loc = do   maybeEnt <- entityAt loc   forM_ maybeEnt igniteEntity  where@@ -177,7 +187,8 @@       when (probabilityOfIgnition >= threshold) $ do         ignitionDelayRand <- uniform (0, 1)         let ignitionDelay =-              floor+              (warmup +)+                . floor                 . min (fromIntegral sourceDuration)                 . negate                 $ log ignitionDelayRand / rate
src/swarm-engine/Swarm/Game/Step/Const.hs view
@@ -11,7 +11,6 @@ -- Implementation of robot commands module Swarm.Game.Step.Const where -import Control.Applicative (Applicative (..)) import Control.Arrow ((&&&)) import Control.Carrier.State.Lazy import Control.Effect.Error@@ -35,7 +34,9 @@ import Data.List.NonEmpty qualified as NE import Data.Map qualified as M import Data.Map.NonEmpty qualified as NEM+import Data.Map.Strict qualified as MS import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing, listToMaybe, mapMaybe)+import Data.MonoidMap qualified as MM import Data.Ord (Down (Down)) import Data.Sequence qualified as Seq import Data.Set (Set)@@ -45,26 +46,27 @@ import Data.Tuple (swap) import Linear (V2 (..), perp, zero) import Swarm.Effect as Effect (Time, getNow)+import Swarm.Failure import Swarm.Game.Achievement.Definitions import Swarm.Game.CESK import Swarm.Game.Display import Swarm.Game.Entity hiding (empty, lookup, singleton, union) import Swarm.Game.Entity qualified as E import Swarm.Game.Exception-import Swarm.Game.Failure import Swarm.Game.Land import Swarm.Game.Location import Swarm.Game.Recipe-import Swarm.Game.ResourceLoading (getDataFileNameSafe) import Swarm.Game.Robot import Swarm.Game.Robot.Activity import Swarm.Game.Robot.Concrete import Swarm.Game.Robot.Walk (emptyExceptions)-import Swarm.Game.Scenario.Topography.Area (getAreaDimensions)+import Swarm.Game.Scenario (RecognizableStructureContent)+import Swarm.Game.Scenario.Topography.Area (getNEGridDimensions, rectHeight) import Swarm.Game.Scenario.Topography.Navigation.Portal (Navigation (..)) import Swarm.Game.Scenario.Topography.Navigation.Util import Swarm.Game.Scenario.Topography.Navigation.Waypoint (WaypointName (..))-import Swarm.Game.Scenario.Topography.Structure.Recognition (automatons, foundStructures)+import Swarm.Game.Scenario.Topography.Structure.Named (StructureName (..))+import Swarm.Game.Scenario.Topography.Structure.Recognition (foundStructures) import Swarm.Game.Scenario.Topography.Structure.Recognition.Registry (foundByName) import Swarm.Game.Scenario.Topography.Structure.Recognition.Type import Swarm.Game.State@@ -87,22 +89,25 @@ import Swarm.Game.Value import Swarm.Language.Capability import Swarm.Language.Key (parseKeyComboFull)+import Swarm.Language.Parser.Value (readValue) import Swarm.Language.Pipeline-import Swarm.Language.Pretty (prettyText) import Swarm.Language.Requirements qualified as R import Swarm.Language.Syntax import Swarm.Language.Syntax.Direction import Swarm.Language.Text.Markdown qualified as Markdown import Swarm.Language.Value import Swarm.Log+import Swarm.Pretty (prettyText)+import Swarm.ResourceLoading (getDataFileNameSafe) import Swarm.Util hiding (both) import Swarm.Util.Effect (throwToMaybe) import Swarm.Util.Lens (inherit) import Text.Megaparsec (runParser) import Witch (From (from), into)-import Prelude hiding (Applicative (..), lookup)+import Prelude hiding (lookup) --- | How to handle failure, for example when moving to blocked location+-- | How to handle failure, for example when moving into liquid or+--   attempting to move to a blocked location data RobotFailure = ThrowExn | Destroy | IgnoreFail  -- | How to handle different types of failure when moving/teleporting@@ -134,12 +139,12 @@   when (isTangible c) $     activityCounts . tangibleCommandCount += 1 -  activityCounts . commandsHistogram %= M.insertWith (+) c 1+  activityCounts . commandsHistogram %= MS.insertWith (+) c 1    -- Now proceed to actually carry out the operation.   case c of     Noop -> return $ mkReturn ()-    Return -> case vs of+    Pure -> case vs of       [v] -> return $ Out v s k       _ -> badConst     Wait -> case vs of@@ -210,22 +215,20 @@       -- If unobstructed, the robot will move even if       -- there is nothing to push.       maybeCurrentE <- entityAt nextLoc-      case maybeCurrentE of-        Just e -> do-          -- Make sure there's nothing already occupying the destination-          nothingHere <- isNothing <$> entityAt placementLoc-          nothingHere `holdsOrFail` ["Something is in the way!"]+      forM_ maybeCurrentE $ \e -> do+        -- Make sure there's nothing already occupying the destination+        nothingHere <- isNothing <$> entityAt placementLoc+        nothingHere `holdsOrFail` ["Something is in the way!"] -          let verbed = verbedGrabbingCmd Push'-          -- Ensure it can be pushed.-          omni <- isPrivilegedBot-          (omni || e `hasProperty` Pushable || e `hasProperty` Pickable && not (e `hasProperty` Liquid))-            `holdsOrFail` ["The", e ^. entityName, "here can't be", verbed <> "."]+        let verbed = verbedGrabbingCmd Push'+        -- Ensure it can be pushed.+        omni <- isPrivilegedBot+        (omni || e `hasProperty` Pushable || e `hasProperty` Pickable && not (e `hasProperty` Liquid))+          `holdsOrFail` ["The", e ^. entityName, "here can't be", verbed <> "."] -          -- Place the entity and remove it from previous loc-          updateEntityAt nextLoc (const Nothing)-          updateEntityAt placementLoc (const (Just e))-        Nothing -> return ()+        -- Place the entity and remove it from previous loc+        updateEntityAt nextLoc (const Nothing)+        updateEntityAt placementLoc (const (Just e))        updateRobotLocation loc nextLoc       return $ mkReturn ()@@ -272,35 +275,13 @@       _ -> 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     Sow -> case vs of@@ -367,8 +348,9 @@         -- Make sure the robot has the thing in its inventory         e <- hasInInventoryOrFail name -        -- Place the entity and remove it from the inventory-        updateEntityAt loc (const (Just e))+        -- Place the entity (if it is not evanescent) and remove it from the inventory+        unless (Evanescent `S.member` (e ^. entityProperties)) $+          updateEntityAt loc (const (Just e))         robotInventory %= delete e          flagRedraw@@ -427,6 +409,13 @@           equippedDevices %= insert item           robotInventory %= delete item +          -- Check whether we should bestow the 'EquippedAllDevices' achievement+          curScenario <- use currentScenarioPath+          when (curScenario == Just "classic.yaml") $ do+            equipped <- S.fromList . map (view entityName) . nonzeroEntities <$> use equippedDevices+            equippable <- use $ discovery . craftableDevices+            when (equippable `S.isSubsetOf` equipped) $ grantAchievementForRobot EquippedAllDevices+           -- Flag the UI for a redraw if we are currently showing our inventory           when (focusedID == myID) flagRedraw @@ -436,9 +425,33 @@       [VText itemName] -> do         item <- ensureEquipped itemName         myID <- use robotID++        -- Speculatively unequip the item         focusedID <- use $ robotInfo . focusedRobotID         equippedDevices %= delete item         robotInventory %= insert item++        -- Now check whether being on the current cell would still be+        -- allowed.+        loc <- use robotLocation+        mfail <- checkMoveFailure loc+        forM_ mfail \case+          PathBlockedBy _ -> do+            -- If unequipping the device would somehow result in the+            -- path being blocked, don't allow it; re-equip the device+            -- and throw an exception.+            robotInventory %= delete item+            equippedDevices %= insert item+            throwError . cmdExn Unequip $+              ["You can't unequip the", item ^. entityName, "right now!"]+          PathLiquid _ -> do+            -- Unequipping a device that gives the Float capability in+            -- the middle of liquid results in drowning, EVEN for+            -- base!  This is currently the only (known) way to get+            -- the `DestroyedBase` achievement.+            selfDestruct .= True+            when (myID == 0) $ grantAchievementForRobot DestroyedBase+         -- Flag the UI for a redraw if we are currently showing our inventory         when (focusedID == myID) flagRedraw         return $ mkReturn ()@@ -529,8 +542,8 @@              where               excludeSelf = (`IS.difference` IS.singleton selfRid)               botsHere (Cosmic swName loc) =-                M.findWithDefault mempty loc $-                  M.findWithDefault mempty swName botsByLocs+                MM.get loc $+                  MM.get swName botsByLocs               botIsVisible = maybe False canSee . (`IM.lookup` rMap)               canSee = not . (^. robotDisplay . invisible) @@ -557,36 +570,38 @@     Whereami -> do       loc <- use robotLocation       return $ mkReturn $ loc ^. planar-    Waypoint -> case vs of-      [VText name, VInt idx] -> do+    LocateMe -> do+      loc <- use robotLocation+      return $ mkReturn (loc ^. subworld, loc ^. planar)+    Waypoints -> case vs of+      [VText name] -> do         lm <- use $ landscape . worldNavigation         Cosmic swName _ <- use robotLocation-        case M.lookup (WaypointName name) $ M.findWithDefault mempty swName $ waypoints lm of-          Nothing -> throwError $ CmdFailed Waypoint (T.unwords ["No waypoint named", name]) Nothing-          Just wps -> return $ mkReturn (NE.length wps, indexWrapNonEmpty wps idx)+        let mwps = M.lookup (WaypointName name) $ M.findWithDefault mempty swName $ waypoints lm+        return $ mkReturn $ maybe [] NE.toList mwps       _ -> badConst-    Structure -> case vs of-      [VText name, VInt idx] -> do+    Structures -> case vs of+      [VText name] -> do         registry <- use $ discovery . structureRecognition . foundStructures-        let maybeFoundStructures = M.lookup name $ foundByName registry-            mkOutput mapNE = (NE.length xs, bottomLeftCorner)+        let maybeFoundStructures = M.lookup (StructureName name) $ foundByName registry+            structures :: [((Cosmic Location, AbsoluteDir), StructureWithGrid RecognizableStructureContent Entity)]+            structures = maybe [] (NE.toList . NEM.toList) maybeFoundStructures++            bottomLeftCorner ((pos, _), struc) = topLeftCorner .+^ offsetHeight              where-              xs = NEM.toList mapNE-              (pos, struc) = indexWrapNonEmpty xs idx               topLeftCorner = pos ^. planar-              offsetHeight = V2 0 $ -fromIntegral (length (entityGrid struc) - 1)-              bottomLeftCorner :: Location-              bottomLeftCorner = topLeftCorner .+^ offsetHeight-        return $ mkReturn $ mkOutput <$> maybeFoundStructures+              offsetHeight = V2 0 $ negate (rectHeight (getNEGridDimensions $ extractedGrid $ entityGrid struc) - 1)++        return $ mkReturn $ map bottomLeftCorner structures       _ -> badConst     Floorplan -> case vs of       [VText name] -> do-        structureTemplates <- use $ discovery . structureRecognition . automatons . originalStructureDefinitions-        let maybeStructure = M.lookup name structureTemplates+        structureTemplates <- use $ landscape . recognizerAutomatons . originalStructureDefinitions+        let maybeStructure = M.lookup (StructureName name) structureTemplates         structureDef <-           maybeStructure             `isJustOr` cmdExn Floorplan (pure $ T.unwords ["Unknown structure", quote name])-        return . mkReturn . getAreaDimensions $ entityProcessedGrid structureDef+        return . mkReturn . getNEGridDimensions $ entityProcessedGrid structureDef       _ -> badConst     HasTag -> case vs of       [VText eName, VText tName] -> do@@ -597,11 +612,11 @@         return $ mkReturn $ tName `S.member` (e ^. entityTags)       _ -> badConst     TagMembers -> case vs of-      [VText tagName, VInt idx] -> do+      [VText tagName] -> do         tm <- use $ discovery . tagMembers         case M.lookup tagName tm of           Nothing -> throwError $ CmdFailed TagMembers (T.unwords ["No tag named", tagName]) Nothing-          Just theMembers -> return $ mkReturn (NE.length theMembers, indexWrapNonEmpty theMembers idx)+          Just theMembers -> return $ mkReturn theMembers       _ -> badConst     Detect -> case vs of       [VText name, VRect x1 y1 x2 y2] -> do@@ -759,34 +774,16 @@       [VText msg] -> do         isPrivileged <- isPrivilegedBot         loc <- use robotLocation-         -- current robot will be inserted into the robot set, so it needs the log         m <- traceLog Said Info msg         emitMessage m-        let measureToLog robLoc = \case-              RobotLog _ _ logLoc -> cosmoMeasure manhattan robLoc logLoc-              SystemLog -> Measurable 0-            addLatestClosest rl = \case-              Seq.Empty -> Seq.singleton m-              es Seq.:|> e-                | e `isEarlierThan` m -> es |> e |> m-                | e `isFartherThan` m -> es |> m-                | otherwise -> es |> e-             where-              isEarlierThan = (<) `on` (^. leTime)-              isFartherThan = (>) `on` (measureToLog rl . view leSource)         let addToRobotLog :: (Has (State GameState) sgn m) => Robot -> m ()-            addToRobotLog r = do-              maybeRidLoc <- evalState r $ do-                hasLog <- hasCapability CLog-                hasListen <- hasCapability CListen-                loc' <- use robotLocation-                rid <- use robotID-                return $ do-                  guard $ hasLog && hasListen-                  Just (rid, loc')-              forM_ maybeRidLoc $ \(rid, loc') ->-                robotInfo . robotMap . at rid . _Just . robotLog %= addLatestClosest loc'+            addToRobotLog r = evalState r $ do+              hasLog <- hasCapability $ CExecute Log+              hasListen <- hasCapability $ CExecute Listen+              rid <- use robotID+              when (hasLog && hasListen) $+                robotInfo . robotMap . at rid . _Just . robotLog %= (|> m)         robotsAround <-           zoomRobots $             if isPrivileged@@ -811,7 +808,7 @@           mm = limitLast . Seq.filter (liftA2 (&&) notMine isClose) $ Seq.takeWhileR (messageIsRecent gs) mq       return $         maybe-          (In (TConst Listen) mempty s (FExec : k)) -- continue listening+          (In (TConst Listen) emptyEnv s (FExec : k)) -- continue listening           (\m -> Out (VText m) s k) -- return found message           mm     Log -> case vs of@@ -910,9 +907,10 @@             omni <- isPrivilegedBot             case omni || not (target ^. systemRobot) of               True -> zoomRobots $ do-                -- Cancel its CESK machine, and put it to sleep.+                -- Cancel its CESK machine, and wake it up to ensure+                -- it can do cleanup + run to completion.                 robotMap . at targetID . _Just . machine %= cancel-                sleepForever targetID+                activateRobot targetID                 return $ mkReturn ()               False -> throwError $ cmdExn c ["You are not authorized to halt that robot."]       _ -> badConst@@ -942,14 +940,15 @@       let neighbor =             find ((/= rid) . (^. robotID)) -- pick one other than ourself               . sortOn ((manhattan `on` view planar) loc . (^. robotLocation)) -- prefer closer-              $ robotsInArea loc 1+              . filter isInteractive+              . robotsInArea loc 1               $ g ^. robotInfo -- all robots within Manhattan distance 1       return $ mkReturn neighbor     MeetAll -> do       loc <- use robotLocation       rid <- use robotID       g <- get @GameState-      let neighborIDs = filter ((/= rid) . (^. robotID)) . robotsInArea loc 1 $ g ^. robotInfo+      let neighborIDs = filter ((/= rid) . (^. robotID)) . filter isInteractive . robotsInArea loc 1 $ g ^. robotInfo       return $ mkReturn neighborIDs     Whoami -> case vs of       [] -> do@@ -977,11 +976,8 @@     Case -> case vs of       [VInj side v, kl, kr] -> return $ Out v s (FApp (bool kl kr side) : k)       _ -> badConst-    Fst -> case vs of-      [VPair v _] -> return $ Out v s k-      _ -> badConst-    Snd -> case vs of-      [VPair _ v] -> return $ Out v s k+    Match -> case vs of+      [VPair v1 v2, kp] -> return $ Out v1 s (FApp kp : FVArg v2 : k)       _ -> badConst     Try -> case vs of       [c1, c2] -> return $ Out c1 s (FApp (VCApp Force []) : FExec : FTry c2 : k)@@ -1169,7 +1165,7 @@                 . at (target ^. robotID)                 . traverse                 . machine-                .= In giveInventory mempty emptyStore [FExec]+                .= In giveInventory emptyEnv emptyStore [FExec]                activateRobot $ target ^. robotID @@ -1226,6 +1222,36 @@     Format -> case vs of       [v] -> return $ mkReturn $ prettyValue v       _ -> badConst+    Read -> case vs of+      [VType ty, VText txt] -> case readValue ty txt of+        Nothing -> raise Read ["Could not read", showT txt, "at type", prettyText ty]+        Just v -> return (mkReturn v)+      _ -> badConst+    Print -> case vs of+      [VText printableName, VText txt] -> do+        printable <- ensureItem printableName "print"+        (printable `hasProperty` Printable)+          `holdsOrFail` ["You cannot print on", indefinite printableName <> "!"]+        let newEntityName = printableName <> ": " <> txt+        robotInventory %= delete printable+        robotInventory %= insert (printable & entityName .~ newEntityName)+        return $ mkReturn newEntityName+      _ -> badConst+    Erase -> case vs of+      [VText printableName] -> do+        toErase <- ensureItem printableName "erase"+        let (baseName, _) = T.break (== ':') printableName+        em <- use $ landscape . terrainAndEntities . entityMap+        erased <-+          lookupEntityName baseName em+            `isJustOrFail` ["I've never heard of", indefiniteQ baseName <> "."]+        (erased `hasProperty` Printable)+          `holdsOrFail` ["You cannot erase", indefinite baseName <> "!"]++        robotInventory %= delete toErase+        robotInventory %= insert erased+        return $ mkReturn baseName+      _ -> badConst     Chars -> case vs of       [VText t] -> return $ mkReturn $ T.length t       _ -> badConst@@ -1255,10 +1281,40 @@       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 -    let equippedDrills = extantElemsWithCapability CDrill ins+    let equippedDrills = extantElemsWithCapability (CExecute Drill) ins         -- Heuristic: choose the drill with the more elaborate name.         -- E.g. "metal drill" vs. "drill"         preferredDrill = listToMaybe $ sortOn (Down . T.length . (^. entityName)) equippedDrills@@ -1348,8 +1404,6 @@   badConstMsg =     T.unlines       [ "Bad application of execConst:"-      , T.pack (show c)-      , T.pack (show vs)       , prettyText (Out (VCApp c (reverse vs)) s k)       ] @@ -1415,7 +1469,7 @@         return $ Out v s k       else do         time <- use $ temporal . ticks-        return . (if remTime <= 1 then id else Waiting (addTicks (fromIntegral remTime) time)) $+        return . applyWhen (remTime > 1) (Waiting (addTicks (fromIntegral remTime) time)) $           Out v s (FImmediate c wf rf : k)    where     remTime = r ^. recipeTime@@ -1445,7 +1499,7 @@      return item -  -- Check the required devices and inventory for running the given+  -- Check the required devices and stocked inventory for running the given   -- command on a target robot.  This function is used in common by   -- both 'Build' and 'Reprogram'.   --@@ -1546,14 +1600,16 @@           `holdsOr` Incapable fixI (R.Requirements (S.fromList capsWithNoDevice) S.empty M.empty) cmd          -- Now, ensure there is at least one device available to be-        -- equipped for each requirement.-        let missingDevices = map snd . filter (null . fst) $ partitionedDevices+        -- equipped for each requirement, and minimize the resulting+        -- sets of device alternatives by removing any set which is a+        -- superset of another.+        let missingDevices = removeSupersets . S.fromList . map snd . filter (null . fst) $ partitionedDevices         let IncapableFixWords fVerb fNoun = formatIncapableFix fixI         null missingDevices           `holdsOrFail` ( singularSubjectVerb subject "do"                             : "not have required " <> fNoun <> ", please"                             : fVerb <> ":"-                            : (("\n  - " <>) . formatDevices <$> missingDevices)+                            : (("\n  - " <>) . formatDevices <$> S.toList missingDevices)                         )          let minimalEquipSet = smallHittingSet (filter (S.null . S.intersection alreadyEquipped) (map fst partitionedDevices))@@ -1603,8 +1659,11 @@       (mAch False)      selfDestruct .= True-    maybe (return ()) grantAchievementForRobot (mAch True)+    forM_ (mAch True) grantAchievementForRobot +  -- Try to move the current robot once cell in a specific direction,+  -- checking for and applying any relevant effects (e.g. throwing an+  -- exception if blocked, drowning in water, etc.)   moveInDirection :: (HasRobotStepState sig m, Has (Lift IO) sig m) => Heading -> m CESK   moveInDirection orientation = do     -- Figure out where we're going@@ -1616,27 +1675,29 @@     updateRobotLocation loc nextLoc     return $ mkReturn () +  -- Given a possible movement failure, apply a movement failure+  -- handler to generate the appropriate effect.   applyMoveFailureEffect ::     (HasRobotStepState sig m, Has (Lift IO) sig m) =>     Maybe MoveFailureMode ->     MoveFailureHandler ->     m ()   applyMoveFailureEffect maybeFailure failureHandler =-    case maybeFailure of-      Nothing -> return ()-      Just failureMode -> case failureHandler failureMode of-        IgnoreFail -> return ()-        Destroy -> destroyIfNotBase $ \b -> case (b, failureMode) of-          (True, PathLiquid _) -> Just RobotIntoWater -- achievement for drowning-          _ -> Nothing-        ThrowExn -> throwError . cmdExn c $-          case failureMode of-            PathBlockedBy ent -> case ent of-              Just e -> ["There is a", e ^. entityName, "in the way!"]-              Nothing -> ["There is nothing to travel on!"]-            PathLiquid e -> ["There is a dangerous liquid", e ^. entityName, "in the way!"]+    forM_ maybeFailure $ \failureMode -> case failureHandler failureMode of+      IgnoreFail -> return ()+      Destroy -> destroyIfNotBase $ \b -> case (b, failureMode) of+        (True, PathLiquid _) -> Just RobotIntoWater -- achievement for drowning+        (False, _) -> Just AttemptSelfDestructBase+        _ -> Nothing+      ThrowExn -> throwError . cmdExn c $+        case failureMode of+          PathBlockedBy ent -> case ent of+            Just e -> ["There is a", e ^. entityName, "in the way!"]+            Nothing -> ["There is nothing to travel on!"]+          PathLiquid e -> ["There is a dangerous liquid", e ^. entityName, "in the way!"] -  -- Determine the move failure mode and apply the corresponding effect.+  -- Check whether there is any failure in moving to the given+  -- location, and apply the corresponding effect if so.   checkMoveAhead ::     (HasRobotStepState sig m, Has (Lift IO) sig m) =>     Cosmic Location ->
src/swarm-engine/Swarm/Game/Step/Path/Cache.hs view
@@ -44,6 +44,7 @@ import Swarm.Game.Location import Swarm.Game.Robot import Swarm.Game.Robot.Walk+import Swarm.Game.Scenario.Topography.Terraform import Swarm.Game.State import Swarm.Game.Step.Path.Cache.DistanceLimit import Swarm.Game.Step.Path.Type@@ -51,7 +52,6 @@ import Swarm.Game.Step.RobotStepState import Swarm.Game.Step.Util.Inspect (robotWithID) import Swarm.Game.Universe (Cosmic (..), SubworldName)-import Swarm.Game.World.Modify import Swarm.Util (prependList, tails1) import Swarm.Util.RingBuffer qualified as RB
src/swarm-engine/Swarm/Game/Step/Path/Walkability.hs view
@@ -11,31 +11,41 @@ import Swarm.Language.Capability  data MoveFailureMode-  = -- | If the robot has a path Whitelist,-    -- then the absence of an entity could prevent walkability (represented by `PathBlockedBy Nothing`).+  = -- | Can't move due to something blocking the path.  Note that if+    --   the robot has a path Whitelist, then the /absence/ of an entity+    --   could block the path (represented by `PathBlockedBy+    --   Nothing`).     PathBlockedBy (Maybe Entity)-  | PathLiquid Entity+  | -- | Some liquid entity is in the path.+    PathLiquid Entity  -- | Pure logic used inside of--- 'Swarm.Game.Step.Util.checkMoveFailureUnprivileged'+--   'Swarm.Game.Step.Util.checkMoveFailureUnprivileged'.  Given a+--   (possibly empty) walkable entity whitelist or blacklist, and the+--   entity (or lack thereof) in the cell we are trying to move to,+--   determine whether there is some kind of movement failure. checkUnwalkable ::   WalkabilityContext ->   Maybe Entity ->   Maybe MoveFailureMode checkUnwalkable (WalkabilityContext _ walkExceptions) Nothing =+  -- If there's no entity in the path, we are blocked only if a+  -- whitelist of walkable entities is specified   case walkExceptions of     Whitelist _ -> Just $ PathBlockedBy Nothing     Blacklist _ -> Nothing checkUnwalkable (WalkabilityContext caps walkExceptions) (Just e)-  -- robots can not walk through walls   | isUnwalkableEntity =       Just $ PathBlockedBy $ Just e-  -- robots drown if they walk over liquid without boat+  -- Robots drown if they walk over liquid without the Float capability   | e `hasProperty` Liquid && CFloat `S.notMember` caps =       Just $ PathLiquid e   | otherwise = Nothing  where   eName = e ^. entityName+  -- An entity blocks a robot if...   isUnwalkableEntity = case walkExceptions of+    -- ...it's not one of the whitelisted entities...     Whitelist onlyWalkables -> eName `S.notMember` onlyWalkables+    -- ...OR if it is inherently unwalkable, or is blacklisted.     Blacklist unwalkables -> e `hasProperty` Unwalkable || eName `S.member` unwalkables
src/swarm-engine/Swarm/Game/Step/Util.hs view
@@ -9,13 +9,13 @@ -- Utilities for implementing robot commands. module Swarm.Game.Step.Util where -import Control.Applicative (Applicative (..)) import Control.Carrier.State.Lazy import Control.Effect.Error import Control.Effect.Lens import Control.Monad (forM_, guard, when) import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Maybe (MaybeT (..), runMaybeT)+import Control.Monad.Trans.State.Strict qualified as TS import Data.Array (bounds, (!)) import Data.IntMap qualified as IM import Data.Set qualified as S@@ -26,10 +26,11 @@ import Swarm.Game.Entity hiding (empty, lookup, singleton, union) import Swarm.Game.Exception import Swarm.Game.Location-import Swarm.Game.ResourceLoading (NameGenerator (..)) import Swarm.Game.Robot+import Swarm.Game.Scenario.Topography.Modify qualified as WM import Swarm.Game.Scenario.Topography.Structure.Recognition.Tracking qualified as SRT import Swarm.Game.State+import Swarm.Game.State.Landscape (recognizerAutomatons) import Swarm.Game.State.Robot import Swarm.Game.State.Substate import Swarm.Game.Step.Path.Cache@@ -39,14 +40,14 @@ import Swarm.Game.Universe import Swarm.Game.World qualified as W import Swarm.Game.World.Coords-import Swarm.Game.World.Modify qualified as WM import Swarm.Language.Capability import Swarm.Language.Requirements.Type qualified as R import Swarm.Language.Syntax import Swarm.Language.Syntax.Direction (Direction)+import Swarm.ResourceLoading (NameGenerator (..)) import Swarm.Util hiding (both) import System.Random (UniformRange, uniformR)-import Prelude hiding (Applicative (..), lookup)+import Prelude hiding (lookup)  deriveHeading :: HasRobotStepState sig m => Direction -> m Heading deriveHeading d = do@@ -61,6 +62,15 @@   let nextLoc = loc `offsetBy` newHeading   (nextLoc,) <$> entityAt nextLoc +adaptGameState ::+  Has (State GameState) sig m =>+  TS.State GameState b ->+  m b+adaptGameState f = do+  (newRecognizer, newGS) <- TS.runState f <$> get+  put newGS+  return newRecognizer+ -- | Modify the entity (if any) at a given location. updateEntityAt ::   (Has (State Robot) sig m, Has (State GameState) sig m) =>@@ -76,8 +86,12 @@     currentTick <- use $ temporal . ticks     myID <- use robotID     zoomRobots $ wakeWatchingRobots myID currentTick cLoc-    SRT.entityModified modType cLoc +    structureRecognizer <- use $ landscape . recognizerAutomatons+    oldRecognition <- use $ discovery . structureRecognition+    newRecognition <- adaptGameState $ SRT.entityModified mtlEntityAt modType cLoc structureRecognizer oldRecognition+    discovery . structureRecognition .= newRecognition+     pcr <- use $ pathCaching . pathCachingRobots     mapM_ (revalidatePathCache cLoc modType) $ IM.toList pcr @@ -162,8 +176,9 @@  -- * Moving --- | Make sure nothing is in the way.--- No exception for system robots+-- | Raw check whether moving to the given location causes any kind of+--   failure, with no special checks for system robots (see also+--   'checkMoveFailure'). checkMoveFailureUnprivileged ::   HasRobotStepState sig m =>   Cosmic Location ->@@ -173,8 +188,10 @@   wc <- use walkabilityContext   return $ checkUnwalkable wc me --- | Make sure nothing is in the way. Note that system robots implicitly ignore--- and base throws on failure.+-- | Check whether moving to the given location causes any kind of+--   failure.  Note that system robots have unrestricted movement and+--   never fail, but non-system robots have restricted movement even+--   in creative mode. checkMoveFailure :: HasRobotStepState sig m => Cosmic Location -> m (Maybe MoveFailureMode) checkMoveFailure nextLoc = do   systemRob <- use systemRobot
src/swarm-engine/Swarm/Game/Step/Util/Command.hs view
@@ -12,7 +12,6 @@ -- Helper functions for "Swarm.Game.Step.Const" commands module Swarm.Game.Step.Util.Command where -import Control.Applicative (Applicative (..)) import Control.Carrier.State.Lazy import Control.Carrier.Throw.Either (ThrowC, runThrow) import Control.Effect.Error@@ -24,6 +23,7 @@ import Data.List (find) import Data.List.NonEmpty qualified as NE import Data.Map qualified as M+import Data.MonoidMap qualified as MM import Data.Sequence qualified as Seq import Data.Set (Set) import Data.Set qualified as S@@ -47,6 +47,7 @@ import Swarm.Game.Robot import Swarm.Game.Robot.Concrete import Swarm.Game.Robot.Walk (emptyExceptions)+import Swarm.Game.Scenario.Status (getScenarioPath) import Swarm.Game.Scenario.Topography.Navigation.Portal (Navigation (..), destination, reorientation) import Swarm.Game.State import Swarm.Game.State.Landscape@@ -63,8 +64,9 @@ import Swarm.Language.Syntax import Swarm.Language.Text.Markdown qualified as Markdown import Swarm.Log+import Swarm.Util (applyWhen) import System.Clock (TimeSpec)-import Prelude hiding (Applicative (..), lookup)+import Prelude hiding (lookup)  data GrabbingCmd   = Grab'@@ -98,19 +100,17 @@   Const ->   m () ensureCanExecute c =-  gets @Robot (constCapsFor c) >>= \case-    Nothing -> pure ()-    Just cap -> do-      isPrivileged <- isPrivilegedBot-      -- Privileged robots can execute commands regardless-      -- of equipped devices, and without expending-      -- a capability's exercise cost.-      unless isPrivileged $ do-        robotCaps <- use robotCapabilities-        let capProviders = M.lookup cap $ getMap robotCaps-        case capProviders of-          Nothing -> throwError $ Incapable FixByEquip (R.singletonCap cap) (TConst c)-          Just rawCosts -> payExerciseCost c rawCosts+  gets @Robot (constCapsFor c) >>= mapM_ \cap -> do+    isPrivileged <- isPrivilegedBot+    -- Privileged robots can execute commands regardless+    -- of equipped devices, and without expending+    -- a capability's exercise cost.+    unless isPrivileged $ do+      robotCaps <- use robotCapabilities+      let capProviders = M.lookup cap $ getMap robotCaps+      case capProviders of+        Nothing -> throwError $ Incapable FixByEquip (R.singletonCap cap) (TConst c)+        Just rawCosts -> payExerciseCost c rawCosts  payExerciseCost ::   ( Has (State Robot) sig m@@ -156,11 +156,10 @@    let isNearby = isNearbyOrExempt privileged myLoc       f loc =-        if not $ isNearby loc-          then IS.delete rid-          else id+        applyWhen (not $ isNearby loc) $+          IS.delete rid -  robotInfo . robotsWatching %= M.filter (not . IS.null) . M.mapWithKey f+  robotInfo . robotsWatching %= MM.mapWithKey f  verbedGrabbingCmd :: GrabbingCmd -> Text verbedGrabbingCmd = \case@@ -185,6 +184,7 @@       newlocWithPortal <- applyPortal newLoc       rid <- use robotID       zoomRobots $ do+        -- wakeWatchingRobots?         removeRobotFromLocationMap oldLoc rid         addRobotToLocation rid newlocWithPortal       modify (unsafeSetRobotLocation newlocWithPortal)@@ -212,14 +212,12 @@     True -> act     False -> do       mtgt <- use (robotInfo . robotMap . at rid)-      case mtgt of-        Nothing -> return ()-        Just tgt -> do-          tgt' <- execState @Robot tgt act-          zoomRobots $-            if tgt' ^. selfDestruct-              then deleteRobot rid-              else robotMap . ix rid .= tgt'+      forM_ mtgt $ \tgt -> do+        tgt' <- execState @Robot tgt act+        zoomRobots $+          if tgt' ^. selfDestruct+            then deleteRobot rid+            else robotMap . ix rid .= tgt'  -- | Enforces validity of the robot's privileged status to receive -- an achievement.@@ -261,7 +259,7 @@       %= M.insertWith         (<>)         a-        (Attainment (GameplayAchievement a) scenarioPath currentTime)+        (Attainment (GameplayAchievement a) (getScenarioPath <$> scenarioPath) currentTime)  -- | Capabilities needed for a specific robot to evaluate or execute a --   constant.  Right now, the only difference is whether the robot is@@ -269,11 +267,11 @@ --   be other exceptions added in the future. constCapsFor :: Const -> Robot -> Maybe Capability constCapsFor Move r-  | r ^. robotHeavy = Just CMoveheavy+  | r ^. robotHeavy = Just CMoveHeavy constCapsFor Backup r-  | r ^. robotHeavy = Just CMoveheavy+  | r ^. robotHeavy = Just CMoveHeavy constCapsFor Stride r-  | r ^. robotHeavy = Just CMoveheavy+  | r ^. robotHeavy = Just CMoveHeavy constCapsFor c _ = constCaps c  -- | Requires that the target location is within one cell.@@ -292,13 +290,11 @@ updateDiscoveredEntities :: (HasRobotStepState sig m) => Entity -> m () updateDiscoveredEntities e = do   allDiscovered <- use $ discovery . allDiscoveredEntities-  if E.contains0plus e allDiscovered-    then pure ()-    else do-      let newAllDiscovered = E.insertCount 1 e allDiscovered-      updateAvailableRecipes (newAllDiscovered, newAllDiscovered) e-      updateAvailableCommands e-      discovery . allDiscoveredEntities .= newAllDiscovered+  unless (E.contains0plus e allDiscovered) $ do+    let newAllDiscovered = E.insertCount 1 e allDiscovered+    updateAvailableRecipes (newAllDiscovered, newAllDiscovered) e+    updateAvailableCommands e+    discovery . allDiscoveredEntities .= newAllDiscovered  -- | Update the availableRecipes list. -- This implementation is not efficient:@@ -341,7 +337,7 @@   m () addWatchedLocation loc = do   rid <- use robotID-  robotInfo . robotsWatching %= M.insertWith (<>) loc (IS.singleton rid)+  robotInfo . robotsWatching %= MM.adjust (IS.insert rid) loc  -- | Give some entities from a parent robot (the robot represented by --   the ambient @State Robot@ effect) to a child robot (represented
src/swarm-engine/Swarm/Game/Tick.hs view
@@ -5,33 +5,49 @@ module Swarm.Game.Tick (   TickNumber (..),   addTicks,+  formatTicks, ) where  import Data.Aeson (FromJSON, ToJSON (..)) import Data.Aeson qualified as A+import Data.Bits (Bits (..)) import Data.Int (Int64)+import Data.List (intersperse) import GHC.Generics (Generic) import Prettyprinter (Pretty (..)) import Swarm.Util.JSON (optionsUnwrapUnary) import Swarm.Util.WindowedCounter (Offsettable (..))+import Text.Printf  -- | A newtype representing a count of ticks (typically since the --   start of a game). newtype TickNumber = TickNumber {getTickNumber :: Int64}   deriving (Eq, Ord, Show, Read, Generic) +-- | Add an offset to a 'TickNumber'.+addTicks :: Int -> TickNumber -> TickNumber+addTicks i (TickNumber n) = TickNumber $ n + fromIntegral i++-- | Format a ticks count as a hexadecimal clock.+formatTicks :: Bool -> TickNumber -> String+formatTicks showTicks (TickNumber t) =+  mconcat $+    intersperse+      ":"+      [ printf "%x" (t `shiftR` 20)+      , printf "%02x" ((t `shiftR` 12) .&. ((1 `shiftL` 8) - 1))+      , printf "%02x" ((t `shiftR` 4) .&. ((1 `shiftL` 8) - 1))+      ]+      ++ if showTicks then [".", printf "%x" (t .&. ((1 `shiftL` 4) - 1))] else []+ instance ToJSON TickNumber where   toJSON = A.genericToJSON optionsUnwrapUnary  instance FromJSON TickNumber where   parseJSON = A.genericParseJSON optionsUnwrapUnary --- | Add an offset to a 'TickNumber'.-addTicks :: Int -> TickNumber -> TickNumber-addTicks i (TickNumber n) = TickNumber $ n + fromIntegral i- instance Offsettable TickNumber where   offsetBy = addTicks  instance Pretty TickNumber where-  pretty (TickNumber i) = pretty i+  pretty = pretty . formatTicks True
src/swarm-engine/Swarm/Game/Value.hs view
@@ -12,12 +12,14 @@ import Data.Either.Extra (maybeToEither) import Data.Int (Int32) import Data.List (uncons)+import Data.List.NonEmpty qualified as NE import Data.Text (Text) import Linear (V2 (..)) 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 @@ -37,6 +39,9 @@ class Valuable a where   asValue :: a -> Value +instance Valuable Value where+  asValue = id+ instance Valuable Int32 where   asValue = VInt . fromIntegral @@ -52,6 +57,9 @@ instance Valuable Text where   asValue = VText +instance Valuable SubworldName where+  asValue = asValue . renderWorldName+ instance Valuable () where   asValue = const VUnit @@ -82,6 +90,9 @@  instance Valuable a => Valuable [a] where   asValue = asValue . uncons++instance Valuable a => Valuable (NE.NonEmpty a) where+  asValue = asValue . NE.toList  instance Valuable AreaDimensions where   asValue (AreaDimensions w h) = asValue (w, h)
− src/swarm-engine/Swarm/Version.hs 
@@ -1,172 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}---- |--- SPDX-License-Identifier: BSD-3-Clause------ Query current and upstream Swarm version.-module Swarm.Version (-  -- * PVP version-  isSwarmReleaseTag,-  version,--  -- ** Upstream release-  tagToVersion,-  upstreamReleaseVersion,-  getNewerReleaseVersion,-  NewReleaseFailure (..),-) where--import Control.Exception (catch, displayException)-import Data.Aeson (Array, Value (..), (.:))-import Data.ByteString qualified as BS-import Data.ByteString.Lazy qualified as BSL-import Data.Char (isDigit)-import Data.Either (lefts, rights)-import Data.Foldable (toList)-import Data.Maybe (listToMaybe)-import Data.Text qualified as T-import Data.Version (Version (..), parseVersion, showVersion)-import Data.Yaml (ParseException, Parser, decodeEither', parseEither)-import GitHash (GitInfo, giBranch)-import Network.HTTP.Client (-  HttpException,-  Request (requestHeaders),-  Response (responseBody),-  httpLbs,-  newManager,-  parseRequest,- )-import Network.HTTP.Client.TLS (tlsManagerSettings)-import Network.HTTP.Types (hUserAgent)-import Paths_swarm qualified-import Swarm.Util (failT, quote)-import Text.ParserCombinators.ReadP (readP_to_S)---- $setup--- >>> import Data.Bifunctor (first)--- >>> import Data.Version (Version (..), parseVersion)--- >>> import Text.ParserCombinators.ReadP (readP_to_S)---- | Check that the tag follows the PVP versioning policy.------ Note that this filters out VS Code plugin releases.-isSwarmReleaseTag :: String -> Bool-isSwarmReleaseTag = all (\c -> isDigit c || c == '.')--version :: String-version =-  let v = showVersion Paths_swarm.version-   in if v == "0.0.0.1" then "pre-alpha version" else v---- | Get the current upstream release version if any.-upstreamReleaseVersion :: IO (Either NewReleaseFailure String)-upstreamReleaseVersion =-  catch-    (either parseFailure getRelease . decodeResp <$> sendRequest)-    (return . Left . queryFailure)- where-  -- -------------------------------  -- send request to GitHub API-  sendRequest :: IO (Response BSL.ByteString)-  sendRequest = do-    manager <- newManager tlsManagerSettings-    request <- parseRequest "https://api.github.com/repos/swarm-game/swarm/releases"-    httpLbs-      request {requestHeaders = [(hUserAgent, "swarm-game/swarm-swarmversion")]}-      manager-  -- -------------------------------  -- get the latest actual release-  getRelease :: Array -> Either NewReleaseFailure String-  getRelease rs =-    let ts = parseReleases rs-        maybeRel = listToMaybe $ rights ts-     in case maybeRel of-          Nothing -> Left $ NoMainUpstreamRelease (lefts ts)-          Just rel -> Right rel-  -- -------------------------------  -- pretty print failures-  parseFailure :: ParseException -> Either NewReleaseFailure String-  parseFailure e = Left . FailedReleaseQuery $ "Failure during response parsing: " <> displayException e-  queryFailure :: HttpException -> NewReleaseFailure-  queryFailure e = FailedReleaseQuery $ "Failure requesting GitHub releases: " <> displayException e-  -- -------------------------------  -- parsing helpers-  decodeResp :: Response BSL.ByteString -> Either ParseException Array-  decodeResp resp = decodeEither' (BS.pack . BSL.unpack $ responseBody resp)-  parseReleases :: Array -> [Either String String]-  parseReleases = map (parseEither parseRelease) . toList--parseRelease :: Value -> Parser String-parseRelease = \case-  Object o -> do-    pre <- o .: "prerelease"-    if pre-      then fail "Not a real release!"-      else do-        t <- o .: "tag_name"-        if isSwarmReleaseTag t-          then return t-          else failT ["The release", quote $ T.pack t, "is not main Swarm release!"]-  _otherValue -> fail "The JSON release is not an Object!"--data NewReleaseFailure where-  FailedReleaseQuery :: String -> NewReleaseFailure-  NoMainUpstreamRelease :: [String] -> NewReleaseFailure-  OnDevelopmentBranch :: String -> NewReleaseFailure-  OldUpstreamRelease :: Version -> Version -> NewReleaseFailure--instance Show NewReleaseFailure where-  show = \case-    FailedReleaseQuery e -> "Failed to query upstream release: " <> e-    NoMainUpstreamRelease fs ->-      "No upstream releases found."-        <> if null fs-          then ""-          else " Rejected:\n" <> unlines (zipWith ((<>) . show @Int) [1 ..] fs)-    OnDevelopmentBranch br -> "Currently on development branch '" <> br <> "', skipping release query."-    OldUpstreamRelease up my ->-      "Upstream release '"-        <> showVersion up-        <> "' is not newer than mine ('"-        <> showVersion my-        <> "')."---- | Read Swarm tag as Version.------ Swarm tags follow the PVP versioning scheme, so comparing them makes sense.------ >>> map (first versionBranch) $ readP_to_S parseVersion "0.1.0.0"--- [([0],".1.0.0"),([0,1],".0.0"),([0,1,0],".0"),([0,1,0,0],"")]--- >>> Version [0,0,0,1] [] < tagToVersion "0.1.0.0"--- True-tagToVersion :: String -> Version-tagToVersion = fst . last . readP_to_S parseVersion---- | Drop trailing zeros from versions so that we can compare them.-normalize :: Version -> Version-normalize (Version ns tags) = Version (dropTrailing0 ns) tags- where-  dropTrailing0 = reverse . dropWhile (== 0) . reverse---- | Get a newer upstream release version.------ This function can fail if the current branch is not main,--- if there is no Internet connection or no newer release.-getNewerReleaseVersion :: Maybe GitInfo -> IO (Either NewReleaseFailure String)-getNewerReleaseVersion mgi =-  case mgi of-    -- when using cabal install, the git info is unavailable, which is of no interest to players-    Nothing -> (>>= getUpVer) <$> upstreamReleaseVersion-    Just gi ->-      if giBranch gi /= "main"-        then return . Left . OnDevelopmentBranch $ giBranch gi-        else (>>= getUpVer) <$> upstreamReleaseVersion- where-  myVer :: Version-  myVer = Paths_swarm.version-  getUpVer :: String -> Either NewReleaseFailure String-  getUpVer upTag =-    let upVer = tagToVersion upTag-     in if normalize myVer >= normalize upVer-          then Left $ OldUpstreamRelease upVer myVer-          else Right upTag
src/swarm-lang/Swarm/Effect/Unify.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE KindSignatures #-}+{-# LANGUAGE OverloadedStrings #-}  -- | -- SPDX-License-Identifier: BSD-3-Clause@@ -13,7 +14,9 @@ import Control.Algebra import Data.Kind (Type) import Data.Set (Set)+import Prettyprinter import Swarm.Language.Types hiding (Type)+import Swarm.Pretty (PrettyPrec (..), ppr, reportBug)  -- | Data type representing available unification operations. data Unification (m :: Type -> Type) k where@@ -56,3 +59,20 @@   --   should never happen.   UnexpandedRecTy :: TypeF UType -> UnificationError   deriving (Show)++instance PrettyPrec UnificationError where+  prettyPrec _ = \case+    Infinite x uty ->+      vsep+        [ "Encountered infinite type" <+> ppr x <+> "=" <+> ppr uty <> "."+        , "Swarm will not infer recursive types; if you want a recursive type, add an explicit type annotation."+        ]+    UnifyErr ty1 ty2 ->+      "Can't unify" <+> ppr ty1 <+> "and" <+> ppr ty2+    UndefinedUserType ty ->+      "Undefined user type" <+> ppr ty+    UnexpandedRecTy ty ->+      vsep+        [ "Unexpanded recursive type" <+> ppr ty <+> "encountered in unifyF."+        , reportBug+        ]
src/swarm-lang/Swarm/Effect/Unify/Fast.hs view
@@ -20,7 +20,7 @@  import Control.Algebra import Control.Applicative (Alternative)-import Control.Carrier.Accum.FixedStrict (AccumC, runAccum)+import Control.Carrier.Accum.Strict (AccumC, runAccum) import Control.Carrier.Reader (ReaderC, runReader) import Control.Carrier.State.Strict (StateC, evalState) import Control.Carrier.Throw.Either (ThrowC, runThrow)@@ -42,6 +42,7 @@ import Swarm.Effect.Unify import Swarm.Effect.Unify.Common import Swarm.Language.Types hiding (Type)+import Swarm.Util.Effect (withThrow) import Prelude hiding (lookup)  ------------------------------------------------------------@@ -130,8 +131,7 @@             (Subst IntVar UType)             ( StateC                 FreshVarCounter-                ( ThrowC UnificationError m-                )+                (ThrowC UnificationError m)             )         )         a@@ -253,7 +253,10 @@         (UTyRec x ty, _) -> unify (unfoldRec x ty) ty2         (_, UTyRec x ty) -> unify ty1 (unfoldRec x ty)         (UTyUser x1 tys, _) -> do-          ty1' <- expandTydef x1 tys+          ty1' <-+            withThrow+              (\(UnexpandedUserType _) -> UndefinedUserType (UTyUser x1 tys))+              (expandTydef x1 tys)           unify ty1' ty2         (_, UTyUser {}) -> unify ty2 ty1         (Free t1, Free t2) -> Free <$> unifyF t1 t2@@ -312,7 +315,7 @@   (TyConF {}, _) -> unifyErr   -- Note that *type variables* are not the same as *unification variables*.   -- Type variables must match exactly.-  (TyVarF v1, TyVarF v2) -> case v1 == v2 of+  (TyVarF _ v1, TyVarF _ v2) -> case v1 == v2 of     True -> pure t1     False -> unifyErr   (TyVarF {}, _) -> unifyErr
src/swarm-lang/Swarm/Effect/Unify/Naive.hs view
@@ -155,7 +155,7 @@     True -> compose <$> zipWithM unify ts1 ts2     False -> unifyErr   (TyConF {}, _) -> unifyErr-  (TyVarF v1, TyVarF v2) -> case v1 == v2 of+  (TyVarF _ v1, TyVarF _ v2) -> case v1 == v2 of     True -> return idS     False -> unifyErr   (TyVarF {}, _) -> unifyErr
src/swarm-lang/Swarm/Language/Capability.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE DerivingVia #-} {-# LANGUAGE OverloadedStrings #-}  -- |@@ -11,6 +12,7 @@ module Swarm.Language.Capability (   Capability (..),   capabilityName,+  parseCapability,   constCaps,   constByCaps, ) where@@ -19,7 +21,9 @@ import Data.Aeson (FromJSONKey, ToJSONKey) import Data.Char (toLower) import Data.Data (Data)+import Data.Foldable (find) import Data.Hashable (Hashable)+import Data.List.Extra (enumerate) import Data.List.NonEmpty qualified as NE import Data.Map (Map) import Data.Maybe (mapMaybe)@@ -28,151 +32,32 @@ import Data.Tuple (swap) import Data.Yaml import GHC.Generics (Generic)-import Swarm.Language.Syntax.Constants (Const (..), allConst)-import Swarm.Util (binTuples, failT)-import Text.Read (readMaybe)+import Generic.Data (FiniteEnumeration (..))+import Prettyprinter (pretty)+import Swarm.Language.Syntax.Constants (Const (..), allConst, constInfo, syntax)+import Swarm.Pretty (PrettyPrec (..))+import Swarm.Util (binTuples, failT, showEnum) import Witch (from) import Prelude hiding (lookup)  -- | Various capabilities which robots can have. data Capability-  = -- | Be powered, i.e. execute anything at all+  = -- | Execute the command or function.+    CExecute Const+  | -- | Be powered, i.e. execute anything at all     CPower-  | -- | Execute the 'Move' command-    CMove-  | -- | Execute the 'Backup' command-    CBackup-  | -- | Execute the 'Volume' command-    CVolume-  | -- | Execute the 'Path' command-    CPath-  | -- | Execute the 'Push' command-    CPush-  | -- | Execute the 'Stride' command-    CMovemultiple-  | -- | Execute the 'Move' command for a heavy robot-    CMoveheavy-  | -- | Execute the 'Turn' command-    ---    -- NOTE: using cardinal directions is separate 'COrient' capability-    CTurn-  | -- | Execute the 'Selfdestruct' command-    CSelfdestruct-  | -- | Execute the 'Grab' command-    CGrab-  | -- | Execute the 'Harvest' command-    CHarvest-  | -- | Execute the 'Sow' command-    CSow-  | -- | Execute the 'Ignite' command-    CIgnite-  | -- | Execute the 'Place' command-    CPlace-  | -- | Execute the 'Ping' command-    CPing-  | -- | Execute the 'Give' command-    CGive-  | -- | Execute the 'Equip' command-    CEquip-  | -- | Execute the 'Unequip' command-    CUnequip-  | -- | Execute the 'Make' command-    CMake-  | -- | Execute the 'Count' command-    CCount-  | -- | Execute the 'Scout' command. Reconnaissance along a line in a direction.-    CRecondir-  | -- | Execute the 'Build' command-    CBuild-  | -- | Execute the 'Salvage' command-    CSalvage-  | -- | Execute the 'Drill' command-    CDrill-  | -- | Execute the 'Waypoint' command-    CWaypoint-  | -- | Execute the 'Structure' and 'Floorplan' commands-    CStructure-  | -- | Execute the 'HasTag' command-    CHastag-  | -- | Execute the 'TagMembers' command-    CTagmembers-  | -- | Execute the 'Whereami' command-    CSenseloc-  | -- | Execute the 'Blocked' command-    CSensefront-  | -- | Execute the 'Ishere' and 'Isempty' commands-    CSensehere-  | -- | Execute the 'Detect' command-    CDetectloc-  | -- | Execute the 'Resonate' and 'Density' commands-    CDetectcount-  | -- | Execute the 'Sniff' command-    CDetectdistance-  | -- | Execute the 'Chirp' command-    CDetectdirection-  | -- | Execute the 'Watch' command-    CWakeself-  | -- | Execute the 'Scan' command-    CScan-  | -- | Execute the 'Random' command-    CRandom-  | -- | Execute the 'Appear' command-    CAppear-  | -- | Execute the 'Create' command-    CCreate-  | -- | Execute the 'Listen' command and passively log messages if also has 'CLog'-    CListen-  | -- | Execute the 'Log' command-    CLog-  | -- | Format values as text-    CFormat-  | -- | Split text into two pieces-    CConcat-  | -- | Join two text values into one-    CSplit-  | -- | Count the characters in a text value-    CCharcount-  | -- | Convert between characters/text and Unicode values-    CCode-  | -- | Don't drown in liquid+  | -- | Allow a heavy robot to perform movements (e.g. move, backup and stride).+    CMoveHeavy+  | -- | Don't drown in liquid.     CFloat-  | -- | Evaluate conditional expressions-    CCond-  | -- | Negate boolean value-    CNegation-  | -- | Evaluate comparison operations-    CCompare-  | -- | Use cardinal direction constants.+  | -- | Allow using absolute directions.     COrient-  | -- | Evaluate arithmetic operations-    CArith   | -- | Store and look up definitions in an environment     CEnv   | -- | Interpret lambda abstractions     CLambda   | -- | Enable recursive definitions     CRecursion-  | -- | Execute the 'Reprogram' command-    CReprogram-  | -- | Execute the `meet` and `meetAll` commands.-    CMeet-  | -- | Capability to introspect and see its own name-    CWhoami-  | -- | Capability to set its own name-    CSetname-  | -- | Capability to move unrestricted to any place-    CTeleport-  | -- | Capability to run commands atomically-    CAtomic-  | -- | Capability to execute swap (grab and place atomically at the same time).-    CSwap-  | -- | Capability to obtain absolute time, namely via the `time` command.-    CTimeabs-  | -- | Capability to utilize relative passage of time, namely via the `wait` command.-    --   This is strictly weaker than "CTimeAbs".-    CTimerel-  | -- | Capability to execute `try`.-    CTry   | -- | Capability for working with sum types.     CSum   | -- | Capability for working with product types.@@ -181,21 +66,35 @@     CRecord   | -- | Debug capability.     CDebug-  | -- | Capability to handle keyboard input.-    CHandleinput-  | -- | Capability to make other robots halt.-    CHalt   | -- | Capability to handle recursive types.     CRectype   | -- | God-like capabilities.  For e.g. commands intended only for     --   checking challenge mode win conditions, and not for use by     --   players.     CGod-  deriving (Eq, Ord, Show, Read, Enum, Bounded, Generic, Hashable, Data, FromJSONKey, ToJSONKey)+  deriving (Eq, Ord, Show, Generic, Hashable, Data, FromJSONKey, ToJSONKey)+  deriving (Enum, Bounded) via (FiniteEnumeration Capability) +instance PrettyPrec Capability where+  prettyPrec _ c = pretty $ T.toLower (from (NE.tail $ showEnum c))++-- | Get the name of the capability for use in UI and YAML. capabilityName :: Capability -> Text-capabilityName = from @String . map toLower . drop 1 . show+capabilityName = \case+  CExecute con -> case con of+    Neg -> "neg"+    _ -> syntax $ constInfo con+  CMoveHeavy -> "move heavy robot"+  cap -> from @String . map toLower . drop 1 $ show cap +-- | Parse the capability name - inverse of 'capabilityName'.+--+-- >>> import Data.List.Extra (enumerate)+-- >>> all (\c -> Just c == parseCapability (capabilityName c)) enumerate+-- True+parseCapability :: Text -> Maybe Capability+parseCapability t = find (\c -> capabilityName c == T.toLower t) enumerate+ instance ToJSON Capability where   toJSON = String . capabilityName @@ -203,7 +102,7 @@   parseJSON = withText "Capability" tryRead    where     tryRead :: Text -> Parser Capability-    tryRead t = case readMaybe . from . T.cons 'C' . T.toTitle $ t of+    tryRead t = case parseCapability t of       Just c -> return c       Nothing -> failT ["Unknown capability", t] @@ -212,141 +111,40 @@ constCaps = \case   -- ----------------------------------------------------------------   -- Some built-in constants that don't require any special capability.-  Noop -> Nothing   AppF -> Nothing+  Base -> Nothing+  Equipped -> Nothing+  Fail -> Nothing   Force -> Nothing-  Return -> Nothing+  Has -> Nothing+  Knows -> Nothing+  Noop -> Nothing   Parent -> Nothing-  Base -> Nothing+  Pure -> Nothing+  Say -> Nothing -- speaking is natural to robots (unlike listening)   Setname -> Nothing   Undefined -> Nothing-  Fail -> Nothing-  Has -> Nothing-  Equipped -> Nothing-  -- speaking is natural to robots (unlike listening)-  Say -> Nothing+  Use -> Nothing -- Recipes alone shall dictate whether things can be "used"+  View -> Nothing -- TODO: #17 should require equipping an antenna   -- TODO: #495   --   the require command will be inlined once the Issue is fixed   --   so the capabilities of the run commands will be checked instead   Run -> Nothing-  -- -----------------------------------------------------------------  -- Some straightforward ones.-  Listen -> Just CListen-  Log -> Just CLog-  Selfdestruct -> Just CSelfdestruct-  Move -> Just CMove-  Backup -> Just CBackup-  Volume -> Just CVolume-  Path -> Just CPath-  Push -> Just CPush-  Stride -> Just CMovemultiple-  Turn -> Just CTurn-  Grab -> Just CGrab-  Harvest -> Just CHarvest-  Sow -> Just CSow-  Ignite -> Just CIgnite-  Place -> Just CPlace-  Ping -> Just CPing-  Give -> Just CGive-  Equip -> Just CEquip-  Unequip -> Just CUnequip-  Make -> Just CMake-  Count -> Just CCount-  If -> Just CCond-  Blocked -> Just CSensefront-  Scan -> Just CScan-  Ishere -> Just CSensehere-  Isempty -> Just CSensehere-  Upload -> Just CScan-  Build -> Just CBuild-  Salvage -> Just CSalvage-  Reprogram -> Just CReprogram-  Meet -> Just CMeet-  MeetAll -> Just CMeet-  Drill -> Just CDrill-  Use -> Nothing -- Recipes alone shall dictate whether things can be "used"-  Neg -> Just CArith-  Add -> Just CArith-  Sub -> Just CArith-  Mul -> Just CArith-  Div -> Just CArith-  Exp -> Just CArith-  Whoami -> Just CWhoami-  Self -> Just CWhoami-  Swap -> Just CSwap-  Atomic -> Just CAtomic-  Instant -> Just CGod-  Time -> Just CTimeabs-  Wait -> Just CTimerel-  Scout -> Just CRecondir-  Whereami -> Just CSenseloc-  Waypoint -> Just CWaypoint-  Structure -> Just CStructure-  Floorplan -> Just CStructure-  HasTag -> Just CHastag-  TagMembers -> Just CTagmembers-  Detect -> Just CDetectloc-  Resonate -> Just CDetectcount-  Density -> Just CDetectcount-  Sniff -> Just CDetectdistance-  Chirp -> Just CDetectdirection-  Watch -> Just CWakeself-  Heading -> Just COrient-  Key -> Just CHandleinput-  InstallKeyHandler -> Just CHandleinput-  Halt -> Just CHalt-  -- -----------------------------------------------------------------  -- Text operations-  Format -> Just CFormat-  Concat -> Just CConcat-  Split -> Just CSplit-  Chars -> Just CCharcount-  CharAt -> Just CCode-  ToChar -> Just CCode-  -- ----------------------------------------------------------------   -- Some God-like abilities.   As -> Just CGod+  Create -> Just CGod+  Instant -> Just CGod   RobotNamed -> Just CGod   RobotNumbered -> Just CGod-  Create -> Just CGod   Surveil -> Just CGod   -- -----------------------------------------------------------------  -- arithmetic-  Eq -> Just CCompare-  Neq -> Just CCompare-  Lt -> Just CCompare-  Gt -> Just CCompare-  Leq -> Just CCompare-  Geq -> Just CCompare-  -- -----------------------------------------------------------------  -- boolean logic-  And -> Just CCond-  Or -> Just CCond-  Not -> Just CNegation-  -- -----------------------------------------------------------------  -- exceptions-  Try -> Just CTry-  -- ----------------------------------------------------------------   -- type-level arithmetic   Inl -> Just CSum   Inr -> Just CSum   Case -> Just CSum-  Fst -> Just CProd-  Snd -> Just CProd   -- TODO: #563 pair syntax (1,2,3...) should require CProd too--  -- -----------------------------------------------------------------  -- Some additional straightforward ones, which however currently-  -- cannot be used in classic mode since there is no craftable item-  -- which conveys their capability. TODO: #26-  Teleport -> Just CTeleport -- Some space-time machine like Tardis?-  Appear -> Just CAppear -- paint?-  Random -> Just CRandom -- randomness device (with bitcoins)?-  -- -----------------------------------------------------------------  -- Some more constants which *ought* to have their own capability but-  -- currently don't.-  View -> Nothing -- TODO: #17 should require equipping an antenna-  Knows -> Nothing+  Match -> Just CProd+  c -> Just (CExecute c)  -- | Inverts the 'constCaps' mapping. constByCaps :: Map Capability (NE.NonEmpty Const)
src/swarm-lang/Swarm/Language/Context.hs view
@@ -1,91 +1,343 @@-{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE OverloadedStrings #-}  -- | -- SPDX-License-Identifier: BSD-3-Clause -- -- Generic contexts (mappings from variables to other things, such as -- types, values, or capability sets) used throughout the codebase.+-- For example, while typechecking we use a context to store a mapping+-- from variables in scope to their types. As another example, at+-- runtime, robots store an 'Env' which contains several contexts,+-- mapping variables to things like their current value, any+-- requirements associated with using the variable, and so on.+--+-- The implementation here goes to some effort to make it possible to+-- serialize and deserialize contexts so that sharing is preserved and+-- the encoding of serialized contexts does not blow up due to+-- repeated values. module Swarm.Language.Context where -import Control.Algebra (Has)+import Control.Algebra (Has, run)+import Control.Carrier.State.Strict (execState) import Control.Effect.Reader (Reader, ask, local)+import Control.Effect.State (State, get, modify) import Control.Lens.Empty (AsEmpty (..)) import Control.Lens.Prism (prism)-import Data.Aeson (FromJSON (..), ToJSON (..), genericParseJSON, genericToJSON)+import Control.Monad (unless)+import Data.Aeson (FromJSON (..), FromJSONKey, ToJSON (..), ToJSONKey, genericParseJSON, genericToJSON, withText) import Data.Data (Data)+import Data.Function (on)+import Data.Hashable+import Data.List.NonEmpty qualified as NE import Data.Map (Map) import Data.Map qualified as M-import Data.Text (Text)+import Data.Semigroup (Sum (..))+import Data.Text qualified as T import GHC.Generics (Generic)-import Swarm.Util.JSON (optionsUnwrapUnary)+import Swarm.Pretty (PrettyPrec (..))+import Swarm.Util (failT, showT)+import Swarm.Util.JSON (optionsMinimize)+import Swarm.Util.Yaml (FromJSONE, getE, liftE, parseJSONE)+import Text.Printf (printf)+import Text.Read (readMaybe) import Prelude hiding (lookup) --- | We use 'Text' values to represent variables.-type Var = Text+------------------------------------------------------------+-- Context hash --- | A context is a mapping from variable names to things.-newtype Ctx t = Ctx {unCtx :: Map Var t}+-- | A context hash is a hash value used to identify contexts without+--   having to compare them for equality.  Hash values are computed+--   homomorphically, so that two equal contexts will be guaranteed to+--   have the same hash value, even if they were constructed with a+--   different sequence of operations.+--+--   The downside of this approach is that, /in theory/, there could+--   be hash collisions, that is, two different contexts which+--   nonetheless have the same hash value.  However, this is extremely+--   unlikely.  The benefit is that everything can be purely+--   functional, without the need to thread around some kind of+--   globally unique ID generation effect.+newtype CtxHash = CtxHash {getCtxHash :: Int}+  deriving (Eq, Ord, Data, Generic, ToJSONKey, FromJSONKey)+  deriving (Semigroup, Monoid) via Sum Int+  deriving (Num) via Int++instance Show CtxHash where+  show (CtxHash h) = printf "%016x" h++instance ToJSON CtxHash where+  toJSON h = toJSON (show h)++instance FromJSON CtxHash where+  parseJSON = withText "hash" $ \t -> case readMaybe ("0x" ++ T.unpack t) of+    Nothing -> fail "Could not parse CtxHash"+    Just h -> pure (CtxHash h)++-- | The hash for a single variable -> value binding.+singletonHash :: (Hashable v, Hashable t) => v -> t -> CtxHash+singletonHash x t = CtxHash $ hashWithSalt (hash x) t++-- | The hash for an entire Map's worth of bindings.+mapHash :: (Hashable v, Hashable t) => Map v t -> CtxHash+mapHash = M.foldMapWithKey singletonHash++------------------------------------------------------------+-- Context structure++-- | 'CtxF' represents one level of structure of a context: a context+--   is either empty, a singleton, or built via deletion or union.+data CtxF f v t+  = CtxEmpty+  | CtxSingle v t+  | CtxDelete v t (f v t)+  | CtxUnion (f v t) (f v t)   deriving (Eq, Show, Functor, Foldable, Traversable, Data, Generic) -instance ToJSON t => ToJSON (Ctx t) where-  toJSON = genericToJSON optionsUnwrapUnary+instance (ToJSON v, ToJSON t, ToJSON (f v t)) => ToJSON (CtxF f v t) where+  toJSON = genericToJSON optionsMinimize -instance FromJSON t => FromJSON (Ctx t) where-  parseJSON = genericParseJSON optionsUnwrapUnary+instance (FromJSON v, FromJSON t, FromJSON (f v t)) => FromJSON (CtxF f v t) where+  parseJSON = genericParseJSON optionsMinimize +-- | Map over the recursive structure stored in a 'CtxF'.+restructureCtx :: (f v t -> g v t) -> CtxF f v t -> CtxF g v t+restructureCtx _ CtxEmpty = CtxEmpty+restructureCtx _ (CtxSingle x t) = CtxSingle x t+restructureCtx h (CtxDelete x t f1) = CtxDelete x t (h f1)+restructureCtx h (CtxUnion f1 f2) = CtxUnion (h f1) (h f2)++-- | A 'CtxTree' is one possible representation of a context,+--   consisting of a structured record of the process by which a+--   context was constructed.  This representation would be terrible+--   for doing efficient variable lookups, but it can be used to+--   efficiently serialize/deserialize the context while recovering+--   sharing.+--+--   It stores a top-level hash of the context, along with a recursive+--   tree built via 'CtxF'.+data CtxTree v t = CtxTree CtxHash (CtxF CtxTree v t)+  deriving (Eq, Functor, Foldable, Traversable, Data, Generic, ToJSON, FromJSON, Show)++------------------------------------------------------------+-- Contexts++-- | A context is a mapping from variable names to things.  We store+--   both a 'Map' (for efficient lookup) as well as a 'CtxTree' (for+--   sharing-aware serializing/deserializing).+data Ctx v t = Ctx {unCtx :: Map v t, ctxStruct :: CtxTree v t}+  deriving (Functor, Traversable, Data, Generic)++-- | Get the top-level hash of a context.+ctxHash :: Ctx v t -> CtxHash+ctxHash (Ctx _ (CtxTree h _)) = h++instance Show (Ctx v t) where+  -- An auto-derived, naive Show instance blows up as it loses all+  -- sharing, so have `show` simply output a placeholder.+  show _ = "<Ctx>"++-- | Compare contexts for equality just by comparing their hashes.+instance Eq (Ctx v t) where+  (==) = (==) `on` ctxHash++instance (Hashable v, Hashable t) => Hashable (Ctx v t) where+  hash = getCtxHash . ctxHash+  hashWithSalt s = hashWithSalt s . getCtxHash . ctxHash++instance Foldable (Ctx v) where+  foldMap f = foldMap f . unCtx++-- | Rebuild a complete 'Ctx' from a 'CtxTree'.+ctxFromTree :: Ord v => CtxTree v t -> Ctx v t+ctxFromTree tree = Ctx (varMap tree) tree+ where+  varMap (CtxTree _ s) = case s of+    CtxEmpty -> M.empty+    CtxSingle x t -> M.singleton x t+    CtxDelete x _ s1 -> M.delete x (varMap s1)+    CtxUnion s1 s2 -> varMap s2 `M.union` varMap s1++-- | "Roll up" one level of context structure while building a new+--   top-level Map and computing an appropriate top-level hash.+--+--   In other words, the input of type @CtxF Ctx t@ represents a+--   context where the topmost level of structure is split out by+--   itself as 'CtxF', with the rest of the recursive structure stored+--   in the embedded 'Ctx' values.  'rollCtx' takes the single level+--   of structure with recursive subtrees and "rolls them up" into one+--   recursive tree.+rollCtx :: (Ord v, Hashable v, Hashable t) => CtxF Ctx v t -> Ctx v t+rollCtx s = Ctx m (CtxTree h (restructureCtx ctxStruct s))+ where+  (m, h) = case s of+    CtxEmpty -> (M.empty, 0)+    CtxSingle x t -> (M.singleton x t, singletonHash x t)+    CtxDelete x _ (Ctx m1 (CtxTree h1 _)) -> case M.lookup x m1 of+      Nothing -> (m1, h1)+      Just t' -> (M.delete x m1, h1 - singletonHash x t')+    CtxUnion (Ctx m1 (CtxTree h1 _)) (Ctx m2 (CtxTree h2 _)) -> (m2 `M.union` m1, h')+     where+      -- `Data.Map.intersection l r` returns a map with common keys,+      -- but values from `l`.  The values in m1 are the ones we want+      -- to subtract from the hash, since they are the ones that will+      -- be overwritten.+      overwritten = M.intersection m1 m2+      h' = h1 + h2 - mapHash overwritten++------------------------------------------------------------+-- Context instances++-- | Serialize a context simply as its hash; we assume that a+--   top-level CtxMap has been seralized somewhere, from which we can+--   recover this context by looking it up.+instance ToJSON (Ctx v t) where+  toJSON = toJSON . ctxHash++-- | Deserialize a context.  We expect to see a hash, and look it up+--   in the provided CtxMap.+instance Ord v => FromJSONE (CtxMap CtxTree v t) (Ctx v t) where+  parseJSONE v = do+    h <- liftE $ parseJSON @CtxHash v+    m <- getE+    case getCtx h m of+      Nothing -> failT ["Encountered unknown context hash", showT h]+      Just ctx -> pure ctx++instance (PrettyPrec t) => PrettyPrec (Ctx v t) where+  prettyPrec _ _ = "<Ctx>"+ -- | The semigroup operation for contexts is /right/-biased union.-instance Semigroup (Ctx t) where+instance (Ord v, Hashable v, Hashable t) => Semigroup (Ctx v t) where   (<>) = union -instance Monoid (Ctx t) where+instance (Ord v, Hashable v, Hashable t) => Monoid (Ctx v t) where   mempty = empty   mappend = (<>) -instance AsEmpty (Ctx t) where+instance AsEmpty (Ctx v t) where   _Empty = prism (const empty) isEmpty    where-    isEmpty (Ctx c)-      | M.null c = Right ()-      | otherwise = Left (Ctx c)+    isEmpty c+      | M.null (unCtx c) = Right ()+      | otherwise = Left c +------------------------------------------------------------+-- Context operations+ -- | The empty context.-empty :: Ctx t-empty = Ctx M.empty+empty :: Ctx v t+-- We could also define empty = rollCtx CtxEmpty but that would introduce an+-- unnecessary Hashable t constraint.+empty = Ctx M.empty (CtxTree mempty CtxEmpty)  -- | A singleton context.-singleton :: Var -> t -> Ctx t-singleton x t = Ctx (M.singleton x t)+singleton :: (Ord v, Hashable v, Hashable t) => v -> t -> Ctx v t+singleton x t = rollCtx $ CtxSingle x t +-- | Create a 'Ctx' from a 'Map'.+fromMap :: (Ord v, Hashable v, Hashable t) => Map v t -> Ctx v t+fromMap m = case NE.nonEmpty (M.assocs m) of+  Nothing -> empty+  Just ne -> foldr1 union (NE.map (uncurry singleton) ne)+ -- | Look up a variable in a context.-lookup :: Var -> Ctx t -> Maybe t-lookup x (Ctx c) = M.lookup x c+lookup :: Ord v => v -> Ctx v t -> Maybe t+lookup x = M.lookup x . unCtx  -- | Look up a variable in a context in an ambient Reader effect.-lookupR :: Has (Reader (Ctx t)) sig m => Var -> m (Maybe t)+lookupR :: (Ord v, Has (Reader (Ctx v t)) sig m) => v -> m (Maybe t) lookupR x = lookup x <$> ask  -- | Delete a variable from a context.-delete :: Var -> Ctx t -> Ctx t-delete x (Ctx c) = Ctx (M.delete x c)+delete :: (Ord v, Hashable v, Hashable t) => v -> Ctx v t -> Ctx v t+delete x ctx@(Ctx m _) = case M.lookup x m of+  Nothing -> ctx+  Just t -> rollCtx $ CtxDelete x t ctx  -- | Get the list of key-value associations from a context.-assocs :: Ctx t -> [(Var, t)]+assocs :: Ctx v t -> [(v, t)] assocs = M.assocs . unCtx +-- | Get the list of bound variables from a context.+vars :: Ctx v t -> [v]+vars = M.keys . unCtx+ -- | Add a key-value binding to a context (overwriting the old one if --   the key is already present).-addBinding :: Var -> t -> Ctx t -> Ctx t-addBinding x t (Ctx c) = Ctx (M.insert x t c)+addBinding :: (Ord v, Hashable v, Hashable t) => v -> t -> Ctx v t -> Ctx v t+addBinding x t ctx = ctx `union` singleton x t  -- | /Right/-biased union of contexts.-union :: Ctx t -> Ctx t -> Ctx t-union (Ctx c1) (Ctx c2) = Ctx (c2 `M.union` c1)+union :: (Ord v, Hashable v, Hashable t) => Ctx v t -> Ctx v t -> Ctx v t+union ctx1 ctx2 = rollCtx $ CtxUnion ctx1 ctx2  -- | Locally extend the context with an additional binding.-withBinding :: Has (Reader (Ctx t)) sig m => Var -> t -> m a -> m a+withBinding :: (Has (Reader (Ctx v t)) sig m, Ord v, Hashable v, Hashable t) => v -> t -> m a -> m a withBinding x ty = local (addBinding x ty)  -- | Locally extend the context with an additional context of --   bindings.-withBindings :: Has (Reader (Ctx t)) sig m => Ctx t -> m a -> m a+withBindings :: (Has (Reader (Ctx v t)) sig m, Ord v, Hashable v, Hashable t) => Ctx v t -> m a -> m a withBindings ctx = local (`union` ctx)++------------------------------------------------------------+-- Context serializing/deserializing++-- | A 'CtxMap' maps context hashes to context structures.  Those+--   structures could either be complete context trees, or just a+--   single level of structure containing more hashes.+type CtxMap f v t = Map CtxHash (CtxF f v t)++-- | Reconstitute the context corresponding to a particular hash, by+--   looking it up in a context map.+getCtx :: Ord v => CtxHash -> CtxMap CtxTree v t -> Maybe (Ctx v t)+getCtx h m = ctxFromTree . CtxTree h <$> M.lookup h m++-- | Turn a context into a context map containing every subtree of its+--   structure.+toCtxMap :: Ord v => Ctx v t -> CtxMap CtxTree v t+toCtxMap (Ctx m s) = run $ execState M.empty (buildCtxMap m s)++-- | Build a context map by keeping track of the incrementally built+--   map in a state effect, and traverse the given context structure+--   to add all subtrees to the map---but, of course, stopping without+--   recursing further whenever we see a hash that is already in the+--   map.+buildCtxMap ::+  forall v t m sig.+  (Ord v, Has (State (CtxMap CtxTree v t)) sig m) =>+  Map v t ->+  CtxTree v t ->+  m ()+buildCtxMap m (CtxTree h s) = do+  cm <- get @(CtxMap CtxTree v t)+  unless (h `M.member` cm) $ do+    modify (M.insert h s)+    case s of+      CtxEmpty -> pure ()+      CtxSingle {} -> pure ()+      CtxDelete x t s1 -> buildCtxMap (M.insert x t m) s1+      CtxUnion s1 s2 -> buildCtxMap m s1 *> buildCtxMap m s2++newtype ConstHash v t = ConstHash CtxHash+  deriving (Eq, Show, Generic, ToJSON, FromJSON)++-- | "Dehydrate" a context map by replacing the actual context trees+--   with single structure layers containing only hashes.  A+--   dehydrated context map is very suitable for serializing, since it+--   makes sharing completely explicit---even if a given context is+--   referenced multiple times, the references are simply hash values,+--   and the context is stored only once, under its hash.+dehydrate :: CtxMap CtxTree v t -> CtxMap ConstHash v t+dehydrate = M.map (restructureCtx (\(CtxTree h1 _) -> ConstHash h1))++-- | "Rehydrate" a dehydrated context map by replacing every hash with+--   an actual context structure.  We do this by building the result+--   as a lazy, recursive map, replacing each hash by the result we+--   get when looking it up in the map being built.  A context which+--   is referenced multiple times will thus be shared in memory.+rehydrate :: CtxMap ConstHash v t -> CtxMap CtxTree v t+rehydrate m = m'+ where+  m' = M.map (restructureCtx (\(ConstHash h) -> CtxTree h (m' M.! h))) m
src/swarm-lang/Swarm/Language/Elaborate.hs view
@@ -6,7 +6,6 @@ -- Term elaboration which happens after type checking. module Swarm.Language.Elaborate where -import Control.Applicative ((<|>)) import Control.Lens (transform, (^.)) import Swarm.Language.Syntax @@ -46,11 +45,11 @@     -- Eventually, once requirements analysis is part of typechecking,     -- we'll infer them both at typechecking time then fill them in     -- during elaboration here.-    SLet ls r x mty mreq t1 t2 ->-      let mty' = case ls of-            LSDef -> mty <|> Just (t1 ^. sType)+    SLet ls r x mty _ mreq t1 t2 ->+      let mpty = case ls of+            LSDef -> Just (t1 ^. sType)             LSLet -> Nothing-       in SLet ls r x mty' mreq t1 t2+       in SLet ls r x mty mpty mreq t1 t2     SBind x (Just ty) _ mreq c1 c2 -> SBind x Nothing (Just ty) mreq c1 c2     -- Rewrite @f $ x@ to @f x@.     SApp (Syntax' _ (SApp (Syntax' _ (TConst AppF) _ _) l) _ _) r -> SApp l r@@ -62,16 +61,16 @@ insertSuspend :: Term -> Term insertSuspend t = case t of   -- Primitive things which have type Cmd Unit: p => (p ; suspend ())-  TRequireDevice {} -> thenSuspend   TRequire {} -> thenSuspend+  TStock {} -> thenSuspend   TRequirements {} -> thenSuspend   -- Recurse through def, tydef, bind, and annotate.-  TLet ls r x mty mreq t1 t2 -> TLet ls r x mty mreq t1 (insertSuspend t2)+  TLet ls r x mty mpty mreq t1 t2 -> TLet ls r x mty mpty mreq t1 (insertSuspend t2)   TTydef x pty mtd t1 -> TTydef x pty mtd (insertSuspend t1)   TBind mx mty mreq c1 c2 -> TBind mx mty mreq c1 (insertSuspend c2)   TAnnotate t1 ty -> TAnnotate (insertSuspend t1) ty-  -- Replace return or noop with suspend-  TApp (TConst Return) t1 -> TSuspend t1+  -- Replace pure or noop with suspend+  TApp (TConst Pure) t1 -> TSuspend t1   TConst Noop -> TSuspend TUnit   -- Anything else: p => (__res__ <- p; suspend __res__)   --
src/swarm-lang/Swarm/Language/Format.hs view
@@ -1,4 +1,6 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE QuasiQuotes #-}  -- | -- SPDX-License-Identifier: BSD-3-Clause@@ -8,20 +10,26 @@  import Control.Applicative ((<|>)) import Control.Lens ((&), (.~))+import Data.Foldable (foldl')+import Data.Set qualified as S+import Data.Set.Lens (setOf) import Data.Text (Text) import Data.Text qualified as T import Data.Text.IO qualified as T import Prettyprinter import Prettyprinter.Render.Text qualified as RT import Swarm.Language.Parser (readTerm')-import Swarm.Language.Parser.Core (LanguageVersion, defaultParserConfig, languageVersion)-import Swarm.Language.Pretty+import Swarm.Language.Parser.Core (LanguageVersion (..), defaultParserConfig, languageVersion)+import Swarm.Language.Parser.QQ (astQ)+import Swarm.Language.Syntax+import Swarm.Pretty (ppr) import Swarm.Util ((?)) import System.Console.Terminal.Size qualified as Term import System.Exit (exitFailure) import System.IO (stderr) import Text.Megaparsec.Error (errorBundlePretty) import Witch (into)+import Prelude hiding (Foldable (..))  -- | From where should the input be taken? data FormatInput = Stdin | InputFile FilePath@@ -67,9 +75,27 @@ formatSwarm (FormatConfig _ _ mWidth ver) content = case readTerm' cfg content of   Right Nothing -> Right ""   Right (Just ast) ->-    let mkOpt w = LayoutOptions (AvailablePerLine w 1.0)+    let ast' = case ver of+          SwarmLang0_6 -> addProjections_v7 ast+          _ -> ast+        mkOpt w = LayoutOptions (AvailablePerLine w 1.0)         opt = (mkOpt <$> mWidth) ? defaultLayoutOptions-     in Right . RT.renderStrict . layoutPretty opt $ ppr ast+     in Right . RT.renderStrict . layoutPretty opt $ ppr ast'   Left e -> Left (into @Text $ errorBundlePretty e)  where   cfg = defaultParserConfig & languageVersion .~ ver++-- | Version 0.6 of Swarm had keywords 'fst' and 'snd'; version 0.7+--   has 'match' instead.  Add definitions of 'fst' and 'snd' if the AST+--   contains free variables with those names.+addProjections_v7 :: Syntax -> Syntax+addProjections_v7 ast = foldl' addDefn ast (reverse $ S.toList freeProjs)+ where+  -- Any free occurrences of 'fst' or 'snd'?+  freeProjs = setOf freeVarsV ast `S.intersection` S.fromList ["fst", "snd"]++  addDefn :: Syntax -> Var -> Syntax+  addDefn rest = \case+    "fst" -> [astQ| def fst = \p. match p (\a. \_. a) end; $syn:rest |]+    "snd" -> [astQ| def snd = \p. match p (\_. \b. b) end; $syn:rest |]+    _ -> rest
src/swarm-lang/Swarm/Language/JSON.hs view
@@ -11,10 +11,10 @@ import Data.Aeson (FromJSON (..), ToJSON (..), genericParseJSON, genericToJSON, withText) import Data.Aeson qualified as Ae import Swarm.Language.Pipeline (processTermEither)-import Swarm.Language.Pretty (prettyText) import Swarm.Language.Syntax (Term) import Swarm.Language.Syntax.Pattern (Syntax, TSyntax)-import Swarm.Language.Value (Env, Value)+import Swarm.Language.Value (Env, Value (..))+import Swarm.Pretty (prettyText) import Swarm.Util.JSON (optionsMinimize) import Witch (into) @@ -24,16 +24,56 @@ instance ToJSON TSyntax where   toJSON = Ae.String . prettyText -instance FromJSON Term-instance FromJSON Syntax-instance ToJSON Term-instance ToJSON Syntax+instance FromJSON Term where+  parseJSON = genericParseJSON optionsMinimize +instance FromJSON Syntax where+  parseJSON = genericParseJSON optionsMinimize++instance ToJSON Term where+  toJSON = genericToJSON optionsMinimize++instance ToJSON Syntax where+  toJSON = genericToJSON optionsMinimize+ instance ToJSON Value where   toJSON = genericToJSON optionsMinimize -instance FromJSON Value where-  parseJSON = genericParseJSON optionsMinimize+-- TODO (#2213): Craft some appropriate FromJSONE instances for things+-- like Value and Env.  Below is an early experiment. -deriving instance FromJSON Env-deriving instance ToJSON Env+-- instance FromJSONE (CtxMap CtxTree t) Value where+--   parseJSONE = withObjectE "Value" $ \v -> case Ae.toList v of+--     [("VUnit", _)] -> pure VUnit+--     [("VInt", n)] -> VInt <$> liftE (parseJSON n)+--     [("VText", t)] -> VText <$> liftE (parseJSON t)+--     [("VInj", Ae.Array (V.toList -> [i, x]))] -> VInj <$> liftE (parseJSON i) <*> parseJSONE x+--     [("VPair", Ae.Array (V.toList -> [v1, v2]))] -> VPair <$> parseJSONE v1 <*> parseJSONE v2+--     [("VClo", Ae.Array (V.toList -> [x, t, e]))] ->+--       VClo <$> liftE (parseJSON x) <*> liftE (parseJSON t) <*> parseJSONE e+--     [("VCApp", Ae.Array (V.toList -> [c, vs]))] ->+--       VCApp <$> liftE (parseJSON c) <*> parseJSONE vs+--     [("VBind", Ae.Array (V.toList -> [x, ty, r, t1, t2, e]))] ->+--       VBind+--         <$> liftE (parseJSON x)+--         <*> liftE (parseJSON ty)+--         <*> liftE (parseJSON r)+--         <*> liftE (parseJSON t1)+--         <*> liftE (parseJSON t2)+--         <*> parseJSONE e+--     [("VDelay", Ae.Array (V.toList -> [t, e]))] ->+--       VDelay <$> liftE (parseJSON t) <*> parseJSONE e+--     [("VRef", n)] -> VRef <$> liftE (parseJSON n)+--     [("VIndir", n)] -> VIndir <$> liftE (parseJSON n)+--     [("VRcd", m)] -> VRcd <$> parseJSONE m+--     [("VKey", k)] -> VKey <$> liftE (parseJSON k)+--     [("VRequirements", Ae.Array (V.toList -> [txt, t, e]))] ->+--       VRequirements <$> liftE (parseJSON txt) <*> liftE (parseJSON t) <*> parseJSONE e+--     [("VSuspend", Ae.Array (V.toList -> [t, e]))] ->+--       VSuspend <$> liftE (parseJSON t) <*> parseJSONE e+--     [("VExc", _)] -> pure VExc+--     [("VBlackhole", _)] -> pure VBlackhole+--     _ -> fail "parseJSONE: Unable to parse Value"++instance ToJSON Env where+  toJSON = genericToJSON optionsMinimize
src/swarm-lang/Swarm/Language/Key.hs view
@@ -20,6 +20,7 @@  import Data.Aeson (FromJSON, ToJSON) import Data.Foldable (asum)+import Data.Hashable (Hashable) import Data.Kind qualified import Data.List (sort, (\\)) import Data.Set (Set)@@ -37,10 +38,13 @@ ------------------------------------------------------------ -- Parsing +deriving instance Hashable V.Modifier+deriving instance Hashable V.Key+ -- | A keyboard input, represented as a key + modifiers.  Invariant: --   the modifier list is always sorted. data KeyCombo = KeyCombo V.Key [V.Modifier]-  deriving (Eq, Ord, Show, Generic, FromJSON, ToJSON)+  deriving (Eq, Ord, Show, Generic, Hashable, FromJSON, ToJSON)  deriving instance FromJSON V.Key deriving instance FromJSON V.Modifier
src/swarm-lang/Swarm/Language/Kindcheck.hs view
@@ -1,11 +1,14 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ViewPatterns #-}+ -- | -- SPDX-License-Identifier: BSD-3-Clause ----- Kind checking for the Swarm language.+-- Kind checking + type name resolution for the Swarm language. module Swarm.Language.Kindcheck (   KindError (..),-  checkPolytypeKind,-  checkKind,+  processPolytype,+  processType, ) where  import Control.Algebra (Has)@@ -13,8 +16,53 @@ import Control.Effect.Throw (Throw, throwError) import Control.Monad.Extra (unlessM) import Data.Fix (Fix (..))+import Prettyprinter (hsep, nest, pretty, vsep, (<+>)) import Swarm.Language.Types+import Swarm.Pretty (PrettyPrec (..), ppr)+import Swarm.Util (number)+import Swarm.Util.Effect (withThrow) +------------------------------------------------------------+-- Type processing++-- | Process a polytype, by doing name resolution and kind checking,+--   and returning an appropriate 'TydefInfo' record to be used in the+--   case of a type definition.+processPolytype :: (Has (Reader TDCtx) sig m, Has (Throw KindError) sig m) => Polytype -> m TydefInfo+processPolytype pty@(unPoly -> (xs, _)) = do+  pty' <- traverse processType pty+  pure $ TydefInfo pty' (Arity $ length xs)++-- | Process a type by doing name resolution and kind checking.+processType :: (Has (Reader TDCtx) sig m, Has (Throw KindError) sig m) => Type -> m Type+processType ty = do+  ty' <- resolveTydefs ty+  checkKind ty'+  pure ty'++------------------------------------------------------------+-- Tydef name resolution++-- | Name resolution for user-defined type names: for each+--   user-defined type name found anywhere in the type, resolve it to+--   the correct version number depending on what is in scope, by+--   calling 'resolveUserTy'.+resolveTydefs :: Has (Reader TDCtx) sig m => Type -> m Type+resolveTydefs (Fix tyF) =+  Fix <$> case tyF of+    TyConF tc tys -> do+      tc' <- case tc of+        TCUser u -> TCUser <$> resolveUserTy u+        _ -> pure tc+      TyConF tc' <$> mapM resolveTydefs tys+    TyRcdF m -> TyRcdF <$> mapM resolveTydefs m+    TyRecF x t -> TyRecF x <$> resolveTydefs t+    TyVarF {} -> pure tyF+    TyRecVarF {} -> pure tyF++------------------------------------------------------------+-- Kind checking+ -- | Kind checking errors that can occur. data KindError   = -- | A type constructor expects n arguments, but was given these@@ -30,9 +78,33 @@     VacuousRecTy Var Type   deriving (Eq, Show) --- | Check that a polytype is well-kinded.-checkPolytypeKind :: (Has (Reader TDCtx) sig m, Has (Throw KindError) sig m) => Polytype -> m TydefInfo-checkPolytypeKind pty@(Forall xs t) = TydefInfo pty (Arity $ length xs) <$ checkKind t+instance PrettyPrec KindError where+  prettyPrec _ = \case+    ArityMismatch c a tys ->+      nest 2 . vsep $+        [ "Kind error:"+        , hsep+            [ ppr c+            , "requires"+            , pretty a+            , "type"+            , pretty (number a "argument" <> ",")+            , "but was given"+            , pretty (length tys)+            ]+        ]+          ++ ["in the type:" <+> ppr (TyConApp c tys) | not (null tys)]+    UndefinedTyCon tc _ty -> "Undefined type" <+> ppr tc+    TrivialRecTy x ty ->+      nest 2 . vsep $+        [ "Encountered trivial recursive type" <+> ppr (TyRec x ty)+        , "Did you forget to use" <+> ppr x <+> "in the body of the type?"+        ]+    VacuousRecTy x ty ->+      nest 2 . vsep $+        [ "Encountered vacuous recursive type" <+> ppr (TyRec x ty)+        , "Recursive types must be productive, i.e. must not expand to themselves."+        ]  -- | Check that a type is well-kinded. For now, we don't allow --   higher-kinded types, *i.e.* all kinds will be of the form @Type@@ -57,7 +129,7 @@       Just a -> case compare (length tys) a of         EQ -> mapM_ checkKind tys         _ -> throwError $ ArityMismatch c a tys-  TyVarF _ -> return ()+  TyVarF _ _ -> return ()   TyRcdF m -> mapM_ checkKind m   TyRecF x t -> do     -- It's important to call checkKind first, to rule out undefined@@ -66,7 +138,7 @@     -- index 0 in the body.  This doesn't affect the checking but it     -- does ensure that error messages will use the variable name and     -- not de Bruijn indices.-    checkKind (substRec (TyVarF x) t NZ)+    checkKind (substRec (TyVarF x x) t NZ)     -- Now check that the recursive type is well-formed.  We call this     -- with the *unsubstituted* t because the check will be looking     -- for de Bruijn variables specifically.@@ -89,16 +161,23 @@  -- | Check whether a type contains a specific bound recursive type --   variable.-containsVar :: Has (Reader TDCtx) sig m => Nat -> Type -> m Bool-containsVar i (Fix tyF) = case tyF of+containsVar ::+  (Has (Reader TDCtx) sig m, Has (Throw KindError) sig m) =>+  Nat ->+  Type ->+  m Bool+containsVar i ty@(Fix tyF) = case tyF of   TyRecVarF j -> pure (i == j)   TyVarF {} -> pure False   TyConF (TCUser u) tys -> do-    ty' <- expandTydef u tys+    ty' <-+      withThrow+        (\(UnexpandedUserType _) -> UndefinedTyCon (TCUser u) ty)+        (expandTydef u tys)     containsVar i ty'   TyConF _ tys -> or <$> mapM (containsVar i) tys   TyRcdF m -> or <$> mapM (containsVar i) m-  TyRecF _ ty -> containsVar (NS i) ty+  TyRecF _ ty' -> containsVar (NS i) ty'  -- | @nonVacuous ty@ checks that the recursive type @rec x. ty@ is --   non-vacuous, /i.e./ that it doesn't look like @rec x. x@.  Put@@ -109,18 +188,25 @@ --   like @rec x. x@ since we must also (1) expand type aliases and --   (2) ignore additional intervening @rec@s.  For example, given --   @tydef Id a = a@, the type @rec x. rec y. Id x@ is also vacuous.-nonVacuous :: (Has (Reader TDCtx) sig m) => Nat -> Type -> m Bool-nonVacuous i (Fix tyF) = case tyF of+nonVacuous ::+  (Has (Reader TDCtx) sig m, Has (Throw KindError) sig m) =>+  Nat ->+  Type ->+  m Bool+nonVacuous i ty@(Fix tyF) = case tyF of   -- The type simply consists of a variable bound by some @rec@.   -- Check if it's the variable we're currently looking for.   TyRecVarF j -> pure (i /= j)   -- Expand a user-defined type and keep looking.   TyConF (TCUser u) tys -> do-    ty' <- expandTydef u tys+    ty' <-+      withThrow+        (\(UnexpandedUserType _) -> UndefinedTyCon (TCUser u) ty)+        (expandTydef u tys)     nonVacuous i ty'   -- Increment the variable we're looking for when going under a @rec@   -- binder.-  TyRecF _ ty -> nonVacuous (NS i) ty+  TyRecF _ ty' -> nonVacuous (NS i) ty'   -- If we encounter any other kind of type constructor or record   -- type, rejoice!   TyConF {} -> pure True
src/swarm-lang/Swarm/Language/LSP.hs view
@@ -26,9 +26,10 @@ import Swarm.Language.Parser.Core (defaultParserConfig) import Swarm.Language.Parser.Util (getLocRange, showErrorPos) import Swarm.Language.Pipeline (processParsedTerm')-import Swarm.Language.Pretty (prettyText) import Swarm.Language.Syntax (SrcLoc (..)) import Swarm.Language.Typecheck (ContextualTypeErr (..))+import Swarm.Language.Value (emptyEnv)+import Swarm.Pretty (prettyText) import System.IO (stderr) import Witch @@ -89,7 +90,7 @@           VU.Usage _ problems = VU.getUsage mempty term           unusedWarnings = mapMaybe (VU.toErrPos content) problems -          parsingErrors = case processParsedTerm' mempty term of+          parsingErrors = case processParsedTerm' emptyEnv term of             Right _ -> []             Left e -> pure $ showTypeErrorPos content e         Left e -> (pure $ showErrorPos e, [])
src/swarm-lang/Swarm/Language/LSP/Hover.hs view
@@ -23,21 +23,21 @@ import Data.Graph import Data.List.NonEmpty (NonEmpty (..)) import Data.Map qualified as M-import Data.Maybe (catMaybes, fromMaybe)+import Data.Maybe (catMaybes, fromMaybe, isNothing) import Data.Text (Text) import Data.Text qualified as T import Data.Text.Lines qualified as R import Data.Text.Utf16.Rope.Mixed qualified as R import Language.LSP.Protocol.Types qualified as J import Language.LSP.VFS-import Swarm.Language.Context as Ctx import Swarm.Language.Parser (readTerm') import Swarm.Language.Parser.Core (defaultParserConfig) import Swarm.Language.Pipeline (processParsedTerm)-import Swarm.Language.Pretty (prettyText, prettyTextLine) import Swarm.Language.Syntax+import Swarm.Language.TDVar (tdVarName) import Swarm.Language.Typecheck (inferConst) import Swarm.Language.Types+import Swarm.Pretty (prettyText, prettyTextLine) import Swarm.Util qualified as U  withinBound :: Int -> SrcLoc -> Bool@@ -111,14 +111,16 @@ narrowToPosition s0@(Syntax' _ t _ ty) pos = fromMaybe s0 $ case t of   SLam lv _ s -> d (locVarToSyntax' lv $ getInnerType ty) <|> d s   SApp s1 s2 -> d s1 <|> d s2-  SLet _ _ lv _ _ s1@(Syntax' _ _ _ lty) s2 -> d (locVarToSyntax' lv lty) <|> d s1 <|> d s2+  SLet _ _ lv _ _ _ s1@(Syntax' _ _ _ lty) s2 -> d (locVarToSyntax' lv lty) <|> d s1 <|> d s2   SBind mlv _ _ _ s1@(Syntax' _ _ _ lty) s2 -> (mlv >>= d . flip locVarToSyntax' (getInnerType lty)) <|> d s1 <|> d s2+  STydef typ typBody _ti s1 -> d s1 <|> Just (locVarToSyntax' (tdVarName <$> typ) $ fromPoly typBody)   SPair s1 s2 -> d s1 <|> d s2   SDelay s -> d s   SRcd m -> asum . map d . catMaybes . M.elems $ m   SProj s1 _ -> d s1   SAnnotate s _ -> d s   SRequirements _ s -> d s+  SParens s -> d s   -- atoms - return their position and end recursion   TUnit -> Nothing   TConst {} -> Nothing@@ -127,14 +129,15 @@   TText {} -> Nothing   TBool {} -> Nothing   TVar {} -> Nothing+  TStock {} -> Nothing   TRequire {} -> Nothing-  TRequireDevice {} -> Nothing-  STydef {} -> Nothing+  TType {} -> Nothing   -- these should not show up in surface language   TRef {} -> Nothing   TRobot {} -> Nothing   TAntiInt {} -> Nothing   TAntiText {} -> Nothing+  TAntiSyn {} -> Nothing   SSuspend {} -> Nothing  where   d = descend pos@@ -151,6 +154,8 @@   T.unlines $ renderDoc d t : map (treeToMarkdown $ d + 1) children  class Show t => ExplainableType t where+  fromPoly :: Polytype -> t+   -- | Pretty print the type.   prettyType :: t -> Text @@ -166,11 +171,13 @@   eq :: t -> Polytype -> Bool  instance ExplainableType () where+  fromPoly = const ()   prettyType = const "?"   getInnerType = id   eq _ _ = False  instance ExplainableType Polytype where+  fromPoly = id   prettyType = prettyTextLine   getInnerType = fmap $ \case     (l :->: _r) -> l@@ -178,6 +185,15 @@     t -> t   eq = (==) +instance ExplainableType RawPolytype where+  fromPoly = forgetQ+  prettyType = prettyTextLine+  getInnerType = fmap $ \case+    (l :->: _r) -> l+    (TyCmd t) -> t+    t -> t+  eq r t = r == forgetQ t+ explain :: ExplainableType ty => Syntax' ty -> Tree Text explain trm = case trm ^. sTerm of   TUnit -> literal "The unit value."@@ -190,6 +206,8 @@   SRcd {} -> literal "A record literal."   SProj {} -> literal "A record projection."   STydef {} -> literal "A type synonym definition."+  TType {} -> literal "A type literal."+  SParens s -> explain s   -- type ascription   SAnnotate lhs typeAnn ->     Node@@ -197,11 +215,11 @@       [explain lhs]   -- special forms (function application will show for `$`, but really should be rare)   SApp {} -> explainFunction trm-  TRequireDevice {} -> pure "Require a specific device to be equipped."-  TRequire {} -> pure "Require a certain number of an entity."+  TRequire {} -> pure "Require a specific device to be equipped."+  TStock {} -> pure "Stock a certain number of an entity."   SRequirements {} -> pure "Query the requirements of a term."   -- definition or bindings-  SLet ls isRecursive var mTypeAnn _ rhs _b -> pure $ explainDefinition ls isRecursive var (rhs ^. sType) mTypeAnn+  SLet ls isRecursive var mTypeAnn _ _ rhs _b -> pure $ explainDefinition ls isRecursive var (rhs ^. sType) mTypeAnn   SLam (LV _s v) _mType _syn ->     pure $       typeSignature v ty $@@ -230,6 +248,7 @@   TRef {} -> internal "A memory reference."   TAntiInt {} -> internal "An antiquoted Haskell variable name of type Integer."   TAntiText {} -> internal "An antiquoted Haskell variable name of type Text."+  TAntiSyn {} -> internal "An antiquoted Haskell variable name of type Syntax."   TRobot {} -> internal "A robot reference."   SSuspend {} -> internal "A suspension."  where@@ -238,7 +257,7 @@   internal description = literal $ description <> "\n**These should never show up in surface syntax.**"   constGenSig c =     let ity = inferConst c-     in if ty `eq` ity then id else typeSignature (prettyText c) ity+     in U.applyWhen (not $ ty `eq` ity) $ typeSignature (prettyText c) ity  -- | Helper function to explain function application. --@@ -260,7 +279,7 @@           (map explain params)       ] -explainDefinition :: ExplainableType ty => LetSyntax -> Bool -> LocVar -> ty -> Maybe Polytype -> Text+explainDefinition :: ExplainableType ty => LetSyntax -> Bool -> LocVar -> ty -> Maybe RawPolytype -> Text explainDefinition ls isRecursive (LV _s var) ty maybeTypeAnnotation =   typeSignature var ty $     T.unwords@@ -268,7 +287,7 @@       , (if isRecursive then "" else "non-") <> "recursive"       , if ls == LSDef then "definition" else "let"       , "expression"-      , if null maybeTypeAnnotation then "without" else "with"+      , if isNothing maybeTypeAnnotation then "without" else "with"       , "a type annotation on the variable."       ]
src/swarm-lang/Swarm/Language/LSP/VarUsage.hs view
@@ -101,13 +101,35 @@   SLam v _ s -> checkOccurrences bindings v Lambda [s]   SApp s1 s2 -> getUsage bindings s1 <> getUsage bindings s2   -- Warn on unused 'let' bindings...-  SLet LSLet _ v _ _ s1 s2 -> getUsage bindings s1 <> checkOccurrences bindings v Let [s2]+  SLet LSLet _ v _ _ _ s1 s2 -> getUsage bindings s1 <> checkOccurrences bindings v Let [s2]   -- But don't warn on unused 'def' bindings, because they may be   -- intended to be used at a later REPL input.-  SLet LSDef _ _ _ _ s1 s2 -> getUsage bindings s1 <> getUsage bindings s2+  SLet LSDef _ _ _ _ _ s1 s2 -> getUsage bindings s1 <> getUsage bindings s2   SPair s1 s2 -> getUsage bindings s1 <> getUsage bindings s2   SBind maybeVar _ _ _ s1 s2 -> case maybeVar of     Just v -> checkOccurrences bindings v Bind [s1, s2]     Nothing -> getUsage bindings s1 <> getUsage bindings s2   SDelay s -> getUsage bindings s-  _ -> mempty+  SRcd m -> M.foldMapWithKey (\x -> maybe (getUsage bindings (STerm (TVar x))) (getUsage bindings)) m+  SProj s _ -> getUsage bindings s+  SAnnotate s _ -> getUsage bindings s+  SSuspend s -> getUsage bindings s+  SParens s -> getUsage bindings s+  -- Explicitly enumerate the cases with no variables, instead of a+  -- catch-all, so that we get a warning when adding new constructors.+  TUnit {} -> mempty+  TConst {} -> mempty+  TDir {} -> mempty+  TInt {} -> mempty+  TAntiInt {} -> mempty+  TText {} -> mempty+  TAntiText {} -> mempty+  TAntiSyn {} -> mempty+  TBool {} -> mempty+  TRobot {} -> mempty+  TRef {} -> mempty+  TRequire {} -> mempty+  TStock {} -> mempty+  SRequirements {} -> mempty+  STydef {} -> mempty+  TType {} -> mempty
src/swarm-lang/Swarm/Language/Parser.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeFamilies #-}  -- |@@ -10,10 +11,13 @@ -- typechecks, elaborates, and capability checks a term all at once. module Swarm.Language.Parser (   readTerm,+  readNonemptyTerm,   readTerm', ) where +import Control.Monad ((>=>)) import Data.Bifunctor (first, second)+import Data.Either.Extra (maybeToEither) import Data.Sequence (Seq) import Data.Text (Text) import Swarm.Language.Parser.Comment (populateComments)@@ -24,6 +28,13 @@ import Swarm.Language.Syntax (Comment, Syntax) import Text.Megaparsec.Error (errorBundlePretty) import Witch (from)++-- | Parse some input 'Text' completely as a 'Term', consuming leading+--   whitespace and ensuring the parsing extends all the way to the+--   end of the input 'Text'.  Returns an error if the term was only+--   whitespace.+readNonemptyTerm :: Text -> Either Text Syntax+readNonemptyTerm = readTerm >=> maybeToEither "Empty term"  -- | Parse some input 'Text' completely as a 'Term', consuming leading --   whitespace and ensuring the parsing extends all the way to the
src/swarm-lang/Swarm/Language/Parser/Comment.hs view
@@ -39,7 +39,7 @@ -- --   (3) For each suffix comment (i.e. comments after something else --       at the end of a line, or in the middle of a line), attach---       them to the latest node in a postorder traversal which begins+--       them to the latest node in a postorder traversal which ends --       before the comment.  -- | Re-insert parsed comments into an AST.  Prerequisite: the sequence of comments@@ -74,15 +74,15 @@ populateStandaloneComments :: [Comment] -> Syntax -> Syntax populateStandaloneComments cmts =   flip evalState cmts-    . preorder (insertComments srcLocBefore (\c -> beforeComments %~ (|> c)))+    . preorder (insertComments srcLocStartsBefore (\c -> beforeComments %~ (|> c)))  -- | Given a list of suffix comments sorted by 'SrcLoc', insert --   them into the given AST, attaching each comment to the latest---   node in a postorder traversal which begins before it.+--   node in a postorder traversal which ends before it. populateSuffixComments :: [Comment] -> Syntax -> Syntax populateSuffixComments cmts =   flip evalState (reverse cmts)-    . revpostorder (insertComments (flip srcLocBefore) (\c -> afterComments %~ (c <|)))+    . revpostorder (insertComments (flip srcLocEndsBefore) (\c -> afterComments %~ (c <|)))  ------------------------------------------------------------ -- Traversals@@ -108,12 +108,12 @@   go = g >=> mapMOf plate go  -- | Reverse postorder traversal of a 'Plated' structure with a---   monadic transformation.  Apply the transformation recursively to---   all the children in reverse order, then transform the root.+--   monadic transformation.  Transform the root, then apply the+--   transformation recursively to all the children in reverse order. -- -- >>> showTree (evalState (revpostorder next exampleTree) 0)--- "7(6 5(4 3 2) 1(0))"+-- "0(7 3(6 5 4) 1(2))" revpostorder :: (Plated a, Monad m) => (a -> m a) -> (a -> m a) revpostorder g = go  where-  go = mapMOf (backwards plate) go >=> g+  go = g >=> mapMOf (backwards plate) go
src/swarm-lang/Swarm/Language/Parser/Core.hs view
@@ -15,8 +15,9 @@   languageVersion,    -- * Comment parsing state-  CommentState (..),+  WSState (..),   freshLine,+  preWSLoc,   comments,    -- * Parser type@@ -37,6 +38,7 @@ import Data.Sequence qualified as Seq import Data.Text (Text) import Data.Void (Void)+import Language.Haskell.TH qualified as TH import Swarm.Language.Syntax (Comment) import Text.Megaparsec hiding (runParser, runParser') import Text.Megaparsec qualified as MP@@ -57,7 +59,7 @@ -- | Which version of the Swarm language are we parsing?  As a general --   rule, we want to support one older version in addition to the --   current version, to allow for upgrading code via @swarm format@.-data LanguageVersion = SwarmLang0_5 | SwarmLangLatest+data LanguageVersion = SwarmLang0_6 | SwarmLangLatest   deriving (Eq, Ord, Show, Enum, Bounded)  -- | Read-only parser configuration.@@ -75,25 +77,30 @@     , _languageVersion = SwarmLangLatest     } -data CommentState = CS+-- | Miscellaneous state relating to parsing whitespace + comments+data WSState = WS   { _freshLine :: Bool   -- ^ Are we currently on a (so far) blank line, i.e. have there been   --   no nontrivial tokens since the most recent newline?  This field   --   is updated every time we parse a lexeme or symbol (set to   --   false), or a newline (set to true).+  , _preWSLoc :: Int+  -- ^ The last source location before we started consuming+  --   whitespace.  We use this to assign more accurate source spans+  --   to AST nodes, which do *not* include any trailing whitespace.   , _comments :: Seq Comment   -- ^ The actual sequence of comments, in the order they were encountered   } -makeLenses ''CommentState+makeLenses ''WSState -initCommentState :: CommentState-initCommentState = CS {_freshLine = True, _comments = Seq.empty}+initWSState :: WSState+initWSState = WS {_freshLine = True, _preWSLoc = 0, _comments = Seq.empty}  ------------------------------------------------------------ -- Parser types -type Parser = ReaderT ParserConfig (StateT CommentState (Parsec Void Text))+type Parser = ReaderT ParserConfig (StateT WSState (Parsec Void Text))  type ParserError = ParseErrorBundle Text Void @@ -111,22 +118,24 @@ runParser' cfg p t =   (\pt -> parse pt "" t)     . fmap (second (^. comments))-    . flip runStateT initCommentState+    . flip runStateT initWSState     . flip runReaderT cfg     $ p  -- | A utility for running a parser in an arbitrary 'MonadFail' (which --   is going to be the TemplateHaskell 'Language.Haskell.TH.Q' monad --- see --   "Swarm.Language.Parser.QQ"), with a specified source position.-runParserTH :: (Monad m, MonadFail m) => (String, Int, Int) -> Parser a -> String -> m a-runParserTH (file, line, col) p s =+runParserTH :: (Monad m, MonadFail m) => TH.Loc -> Parser a -> String -> m a+runParserTH loc p s =   either (fail . errorBundlePretty) (return . fst)     . snd     . flip MP.runParser' initState-    . flip runStateT initCommentState+    . flip runStateT initWSState     . flip runReaderT defaultParserConfig {_antiquoting = AllowAntiquoting}     $ p  where+  file = TH.loc_filename loc+  (line, col) = TH.loc_start loc   initState :: State Text Void   initState =     (initialState file (from s))
src/swarm-lang/Swarm/Language/Parser/Lex.hs view
@@ -45,7 +45,7 @@   brackets, ) where -import Control.Lens (use, view, (%=), (.=))+import Control.Lens (use, (%=), (.=)) import Control.Monad (void) import Data.Char (isLower, isUpper) import Data.Containers.ListUtils (nubOrd)@@ -58,6 +58,7 @@ import Swarm.Language.Parser.Core import Swarm.Language.Syntax import Swarm.Language.Syntax.Direction+import Swarm.Language.TDVar (TDVar, mkTDVar) import Swarm.Language.Types (baseTyName) import Swarm.Util (failT, squote) import Text.Megaparsec@@ -71,9 +72,14 @@ -- | Add 'SrcLoc' to a parser parseLocG :: Parser a -> Parser (SrcLoc, a) parseLocG pa = do+  -- Remember the start location.   start <- getOffset   a <- pa-  end <- getOffset+  -- Instead of using 'getOffset' to get the end location, which would+  -- include any whitespace consumed at the end of @pa@, get the+  -- @preWSLoc@ which was set by 'sc' at the /beginning/ of the+  -- consumed whitespace.+  end <- use preWSLoc   pure (SrcLoc start end, a)  -- | Add 'SrcLoc' to a 'Term' parser@@ -98,23 +104,34 @@ lineComment :: Text -> Parser () lineComment start = do   cs <- getCommentSituation-  (loc, t) <- parseLocG $ do-    string start *> takeWhileP (Just "character") (/= '\n')-  comments %= (Seq.|> Comment loc LineComment cs t)+  -- Note we must manually get the start and end offset rather than+  -- using parseLocG, since parseLocG explicitly does not include the+  -- source span of trailing whitespace.+  s <- getOffset+  t <- string start *> takeWhileP (Just "character") (/= '\n')+  e <- getOffset+  comments %= (Seq.|> Comment (SrcLoc s e) LineComment cs t)  -- | Parse a block comment, while appending it out-of-band to the list of --   comments saved in the custom state. blockComment :: Text -> Text -> Parser () blockComment start end = do   cs <- getCommentSituation-  (loc, t) <- parseLocG $ do-    void $ string start-    manyTill anySingle (string end)-  comments %= (Seq.|> Comment loc BlockComment cs (into @Text t))+  -- Note we must manually get the start and end offset rather than+  -- using parseLocG, since parseLocG explicitly does not include the+  -- source span of trailing whitespace.+  s <- getOffset+  void $ string start+  t <- manyTill anySingle (string end)+  e <- getOffset+  comments %= (Seq.|> Comment (SrcLoc s e) BlockComment cs (into @Text t))  -- | Skip spaces and comments. sc :: Parser ()-sc =+sc = do+  -- Remember where we were before we started consuming whitespace.+  l <- getOffset+  preWSLoc .= l   -- Typically we would use L.space here, but we have to inline its   -- definition and use our own slight variant, since we need to treat   -- end-of-line specially.@@ -165,7 +182,7 @@  -- | List of keywords built into the language. keywords :: [Text]-keywords = T.words "let in def tydef end true false forall require requirements rec"+keywords = T.words "let in def tydef end true false forall require stock requirements rec"  -- | List of reserved words that cannot be used as variable names. reservedWords :: Set Text@@ -176,12 +193,6 @@       ++ primitiveTypeNames       ++ keywords --- | Cached version of the reserved words list with everything---   lowercase, for use in parsing version 0.5 of the language, where---   types were lowercase instead of uppercase.-lowerReservedWords :: Set Text-lowerReservedWords = S.map T.toLower reservedWords- -- | Parse a reserved word, given a string recognizer (which can --   /e.g./ be case sensitive or not), making sure it is not a prefix --   of a longer variable name, and allowing the parser to backtrack@@ -203,32 +214,26 @@  -- | Parse an identifier together with its source location info. locIdentifier :: IdentifierType -> Parser LocVar-locIdentifier idTy = do-  ver <- view languageVersion-  uncurry LV <$> parseLocG ((lexeme . try) (p >>= check ver) <?> "variable name")+locIdentifier idTy =+  uncurry LV <$> parseLocG ((lexeme . try) (p >>= check) <?> "variable name")  where   p = (:) <$> (letterChar <|> char '_') <*> many (alphaNumChar <|> char '_' <|> char '\'')-  check ver (into @Text -> t) = case ver of-    SwarmLang0_5-      | T.toLower t `S.member` lowerReservedWords ->-          failT ["reserved word", squote t, "cannot be used as variable name"]-      | otherwise -> return t-    SwarmLangLatest-      | IDTyVar <- idTy-      , T.toTitle t `S.member` reservedWords ->-          failT ["Reserved type name", squote t, "cannot be used as a type variable name; perhaps you meant", squote (T.toTitle t) <> "?"]-      | IDTyName <- idTy-      , t `S.member` reservedWords ->-          failT ["Reserved type name", squote t, "cannot be redefined."]-      | t `S.member` reservedWords || T.toLower t `S.member` reservedWords ->-          failT ["Reserved word", squote t, "cannot be used as a variable name"]-      | IDTyName <- idTy-      , isLower (T.head t) ->-          failT ["Type synonym names must start with an uppercase letter"]-      | IDTyVar <- idTy-      , isUpper (T.head t) ->-          failT ["Type variable names must start with a lowercase letter"]-      | otherwise -> return t+  check (into @Text -> t)+    | IDTyVar <- idTy+    , T.toTitle t `S.member` reservedWords =+        failT ["Reserved type name", squote t, "cannot be used as a type variable name; perhaps you meant", squote (T.toTitle t) <> "?"]+    | IDTyName <- idTy+    , t `S.member` reservedWords =+        failT ["Reserved type name", squote t, "cannot be redefined."]+    | t `S.member` reservedWords || T.toLower t `S.member` reservedWords =+        failT ["Reserved word", squote t, "cannot be used as a variable name"]+    | IDTyName <- idTy+    , isLower (T.head t) =+        failT ["Type synonym names must start with an uppercase letter"]+    | IDTyVar <- idTy+    , isUpper (T.head t) =+        failT ["Type variable names must start with a lowercase letter"]+    | otherwise = pure t  -- | Parse a term variable together with its source location info. locTmVar :: Parser LocVar@@ -236,8 +241,8 @@  -- | Parse a user-defined type name together with its source location --   info.-locTyName :: Parser LocVar-locTyName = locIdentifier IDTyName+locTyName :: Parser (Located TDVar)+locTyName = (fmap . fmap) mkTDVar (locIdentifier IDTyName)  -- | Parse an identifier, i.e. any non-reserved string containing --   alphanumeric characters and underscores, not starting with a@@ -253,8 +258,14 @@  -- | Parse a (user-defined) type constructor name, which must start --   with an uppercase letter.-tyName :: Parser Var-tyName = identifier IDTyName+--+--   Note that this always produces a variable with version number 0,+--   via 'mkTDVar'.  We cannot properly version variables at parsing+--   time since we don't know what else is in scope.  There is a+--   separate name resolution pass later that assigns correct version+--   numbers to user type names.+tyName :: Parser TDVar+tyName = mkTDVar <$> identifier IDTyName  -- | Parse a term variable, which can start in any case and just --   cannot be the same (case-insensitively) as a lowercase reserved
src/swarm-lang/Swarm/Language/Parser/QQ.hs view
@@ -1,17 +1,20 @@ -- | -- SPDX-License-Identifier: BSD-3-Clause ----- A quasiquoter for Swarm polytypes.-module Swarm.Language.Parser.QQ (tyQ) where+-- A quasiquoter for Swarm polytypes + untyped terms.+module Swarm.Language.Parser.QQ (tyQ, astQ) where  import Data.Generics import Language.Haskell.TH qualified as TH import Language.Haskell.TH.Quote import Swarm.Language.Parser.Core (runParserTH) import Swarm.Language.Parser.Lex (sc)+import Swarm.Language.Parser.Term (parseTerm) import Swarm.Language.Parser.Type (parsePolytype) import Swarm.Language.Parser.Util (fully)+import Swarm.Language.Syntax import Swarm.Util (liftText)+import Witch (from)  ------------------------------------------------------------ -- Quasiquoters@@ -25,7 +28,10 @@ tyQ =   QuasiQuoter     { quoteExp = quoteTypeExp-    , quotePat = error "quotePat  not implemented for polytypes"+    , -- Using `error` is OK here since a quasiquoter will only ever run+      -- at compile time; hence it can only make compilation fail, not+      -- crash the game at runtime.+      quotePat = error "quotePat  not implemented for polytypes"     , quoteType = error "quoteType not implemented for polytypes"     , quoteDec = error "quoteDec  not implemented for polytypes"     }@@ -33,10 +39,24 @@ quoteTypeExp :: String -> TH.ExpQ quoteTypeExp s = do   loc <- TH.location-  let pos =-        ( TH.loc_filename loc-        , fst (TH.loc_start loc)-        , snd (TH.loc_start loc)-        )-  parsed <- runParserTH pos (fully sc parsePolytype) s+  parsed <- runParserTH loc (fully sc parsePolytype) s   dataToExpQ (fmap liftText . cast) parsed++astQ :: QuasiQuoter+astQ =+  QuasiQuoter+    { quoteExp = quoteASTExp+    , quotePat = error "quotePat  not implemented for ASTs"+    , quoteType = error "quoteType not implemented for ASTs"+    , quoteDec = error "quoteDec  not implemented for ASTs"+    }++quoteASTExp :: String -> TH.ExpQ+quoteASTExp s = do+  loc <- TH.location+  parsed <- runParserTH loc (fully sc parseTerm) s+  dataToExpQ ((fmap liftText . cast) `extQ` antiASTExp) parsed++antiASTExp :: Syntax -> Maybe TH.ExpQ+antiASTExp (STerm (TAntiSyn v)) = Just $ TH.varE (TH.mkName (from v))+antiASTExp _ = Nothing
src/swarm-lang/Swarm/Language/Parser/Record.hs view
@@ -10,14 +10,14 @@  import Data.Map (Map) import Data.Map qualified as M-import Swarm.Language.Context (Var) import Swarm.Language.Parser.Core (Parser) import Swarm.Language.Parser.Lex (symbol, tmVar)+import Swarm.Language.Var (Var) import Swarm.Util (failT, findDup, squote) import Text.Megaparsec (sepBy) --- | Parse something using record syntax of the form @{x1 v1, x2 v2,---   ...}@.  The same parser is used both in parsing record types and+-- | Parse something using record syntax of the form @x1 v1, x2 v2,+--   ...@.  The same parser is used both in parsing record types and --   record values, so it is factored out into its own module. -- --   The @Parser a@ argument is the parser to use for the RHS of each
src/swarm-lang/Swarm/Language/Parser/Term.hs view
@@ -9,14 +9,14 @@ import Control.Lens (view, (^.)) import Control.Monad (guard, join) import Control.Monad.Combinators.Expr-import Data.Foldable (asum)+import Data.Foldable (Foldable (..), asum) import Data.Functor (($>))-import Data.List (foldl') import Data.Map (Map) import Data.Map qualified as M import Data.Maybe (mapMaybe) import Data.Set qualified as S import Data.Set.Lens (setOf)+import Data.Text qualified as T import Swarm.Language.Parser.Core import Swarm.Language.Parser.Lex import Swarm.Language.Parser.Record (parseRecord)@@ -27,6 +27,7 @@ import Swarm.Util (failT, findDup) import Text.Megaparsec hiding (runParser) import Text.Megaparsec.Char+import Prelude hiding (Foldable (..))  -- Imports for doctests (cabal-docspec needs this) @@ -43,11 +44,18 @@  -- | Parse Const as reserved words (e.g. @Fail <$ reserved "fail"@) parseConst :: Parser Const-parseConst = asum (map alternative consts) <?> "built-in user function"+parseConst = do+  ver <- view languageVersion+  asum (map (alternative ver) consts) <?> "built-in user function"  where   consts = filter isUserFunc allConst-  alternative c = c <$ reserved (syntax $ constInfo c)+  alternative ver c = c <$ reserved (syntax $ constInfo' ver c) +  -- Version 0.6 of the language had a constant named @return@, which+  -- is now renamed to @pure@+  constInfo' SwarmLang0_6 Pure = (constInfo Pure) {syntax = "return"}+  constInfo' _ c = constInfo c+ -- | Parse an atomic term, optionally trailed by record projections like @t.x.y.z@. --   Record projection binds more tightly than function application. parseTermAtom :: Parser Syntax@@ -67,14 +75,8 @@         <|> TInt <$> integer         <|> TText <$> textLiteral         <|> TBool <$> ((True <$ reserved "true") <|> (False <$ reserved "false"))-        <|> reserved "require"-          *> ( ( TRequireDevice-                  <$> (textLiteral <?> "device name in double quotes")-               )-                <|> ( (TRequire . fromIntegral <$> integer)-                        <*> (textLiteral <?> "entity name in double quotes")-                    )-             )+        <|> reserved "require" *> parseRequire+        <|> reserved "stock" *> parseStock         <|> uncurry SRequirements <$> (reserved "requirements" *> match parseTerm)         <|> SLam           <$> (symbol "\\" *> locTmVar)@@ -85,27 +87,47 @@           <*> optional (symbol ":" *> parsePolytype)           <*> (symbol "=" *> parseTerm)           <*> (reserved "in" *> parseTerm)-        <|> sLet LSDef-          <$> (reserved "def" *> locTmVar)-          <*> optional (symbol ":" *> parsePolytype)-          <*> (symbol "=" *> parseTerm <* reserved "end")-          <*> (optional (symbol ";") *> (parseTerm <|> (eof $> sNoop)))+        <|> do+          reserved "def"+          locVar@(LV _srcLoc nameText) <- locTmVar+          mTy <- optional (symbol ":" *> parsePolytype)+          _ <- symbol "="+          body <- parseTerm+          reserved "end" <?> ("'end' keyword for definition of '" <> T.unpack nameText <> "'")+          rest <- optional (symbol ";") *> (parseTerm <|> (eof $> sNoop))+          return $ sLet LSDef locVar mTy body rest         <|> STydef           <$> (reserved "tydef" *> locTyName)           <*> join (bindTydef <$> many tyVar <*> (symbol "=" *> parseType <* reserved "end"))           <*> pure Nothing           <*> (optional (symbol ";") *> (parseTerm <|> (eof $> sNoop)))         <|> SRcd <$> brackets (parseRecord (optional (symbol "=" *> parseTerm)))-        <|> parens (view sTerm . mkTuple <$> (parseTerm `sepBy` symbol ","))+        <|> TType <$> (symbol "@" *> parseTypeAtom)     )+    <|> parseLoc (mkTuple <$> parens (parseTerm `sepBy` symbol ","))     <|> parseLoc (TDelay (TConst Noop) <$ try (symbol "{" *> symbol "}"))     <|> parseLoc (SDelay <$> braces parseTerm)     <|> parseLoc (view antiquoting >>= (guard . (== AllowAntiquoting)) >> parseAntiquotation) +-- | Parse the contents of a @require@ statement: either requiring a device, or+--   (if parsing v0.6) requiring inventory stock.+parseRequire :: Parser Term+parseRequire = do+  ver <- view languageVersion+  asum+    [ TRequire <$> (textLiteral <?> "device name in double quotes")+    , guard (ver == SwarmLang0_6) *> parseStock+    ]++parseStock :: Parser Term+parseStock =+  (TStock . fromIntegral <$> integer)+    <*> (textLiteral <?> "entity name in double quotes")+ -- | Construct an 'SLet', automatically filling in the Boolean field --   indicating whether it is recursive.-sLet :: LetSyntax -> LocVar -> Maybe Polytype -> Syntax -> Syntax -> Term-sLet ls x ty t1 = SLet ls (lvVar x `S.member` setOf freeVarsV t1) x ty mempty t1+sLet :: LetSyntax -> LocVar -> Maybe RawPolytype -> Syntax -> Syntax -> Term+sLet ls x ty t1 = SLet ls (lvVar x `S.member` setOf freeVarsV t1) x ty Nothing mempty t1  sNoop :: Syntax sNoop = STerm (TConst Noop)@@ -121,7 +143,7 @@   | not (S.null free) =       failT $         "Undefined type variable(s) on right-hand side of tydef:" : S.toList free-  | otherwise = return $ Forall xs ty+  | otherwise = return . absQuantify $ mkPoly xs ty  where   free = tyVars ty `S.difference` S.fromList xs @@ -129,6 +151,7 @@ parseAntiquotation =   TAntiText <$> (lexeme . try) (symbol "$str:" *> tmVar)     <|> TAntiInt <$> (lexeme . try) (symbol "$int:" *> tmVar)+    <|> TAntiSyn <$> (lexeme . try) (symbol "$syn:" *> tmVar)  -- | Parse a Swarm language term. parseTerm :: Parser Syntax@@ -136,7 +159,7 @@  mkBindChain :: [Stmt] -> Parser Syntax mkBindChain stmts = case last stmts of-  Binder x _ -> return $ foldr mkBind (STerm (TApp (TConst Return) (TVar (lvVar x)))) stmts+  Binder x _ -> return $ foldr mkBind (STerm (TApp (TConst Pure) (TVar (lvVar x)))) stmts   BareTerm t -> return $ foldr mkBind t (init stmts)  where   mkBind (BareTerm t1) t2 = loc Nothing t1 t2 $ SBind Nothing Nothing Nothing Nothing t1 t2@@ -160,7 +183,7 @@ parseExpr =   parseLoc $ ascribe <$> parseExpr' <*> optional (symbol ":" *> parsePolytype)  where-  ascribe :: Syntax -> Maybe Polytype -> Term+  ascribe :: Syntax -> Maybe RawPolytype -> Term   ascribe s Nothing = s ^. sTerm   ascribe s (Just ty) = SAnnotate s ty @@ -199,7 +222,7 @@     pure $       M.singleton         (fixity ci)-        [assI (mkOp c <$ operator (syntax ci))]+        [assI (mkOp c <$> parseLocG (operator (syntax ci)))]  -- | Precedences and parsers of unary operators (currently only 'Neg'). --
src/swarm-lang/Swarm/Language/Parser/Type.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE DataKinds #-} {-# LANGUAGE OverloadedStrings #-}  -- |@@ -12,15 +13,12 @@   parseTyCon, ) where -import Control.Lens (view)-import Control.Monad (join) import Control.Monad.Combinators (many) import Control.Monad.Combinators.Expr (Operator (..), makeExprParser) import Data.Fix (Fix (..), foldFix) import Data.List.Extra (enumerate) import Data.Maybe (fromMaybe)-import Data.Set qualified as S-import Swarm.Language.Parser.Core (LanguageVersion (..), Parser, languageVersion)+import Swarm.Language.Parser.Core (Parser) import Swarm.Language.Parser.Lex (   braces,   brackets,@@ -34,34 +32,16 @@ import Swarm.Language.Parser.Record (parseRecord) import Swarm.Language.Types import Text.Megaparsec (choice, optional, some, (<|>))-import Witch (from)  -- | Parse a Swarm language polytype, which starts with an optional --   quanitifation (@forall@ followed by one or more variables and a --   period) followed by a type.  Note that anything accepted by --   'parseType' is also accepted by 'parsePolytype'.-parsePolytype :: Parser Polytype+parsePolytype :: Parser RawPolytype parsePolytype =-  join $-    ( quantify . fromMaybe []-        <$> optional ((reserved "forall" <|> reserved "∀") *> some tyVar <* symbol ".")-    )-      <*> parseType- where-  quantify :: [Var] -> Type -> Parser Polytype-  quantify xs ty-    -- Iplicitly quantify over free type variables if the user didn't write a forall-    | null xs = return $ Forall (S.toList free) ty-    -- Otherwise, require all variables to be explicitly quantified-    | S.null free = return $ Forall xs ty-    | otherwise =-        fail $-          unlines-            [ "  Type contains free variable(s): " ++ unwords (map from (S.toList free))-            , "  Try adding them to the 'forall'."-            ]-   where-    free = tyVars ty `S.difference` S.fromList xs+  mkPoly . fromMaybe []+    <$> optional ((reserved "forall" <|> reserved "∀") *> some tyVar <* symbol ".")+    <*> parseType  -- | Parse a Swarm language (mono)type. parseType :: Parser Type@@ -97,14 +77,8 @@ -- | A type constructor. parseTyCon :: Parser TyCon parseTyCon = do-  ver <- view languageVersion-  let reservedCase = case ver of-        -- Version 0.5 of the language accepted type names in any case-        SwarmLang0_5 -> reserved-        -- The latest version requires them to be uppercase-        SwarmLangLatest -> reservedCS-  choice (map (\b -> TCBase b <$ reservedCase (baseTyName b)) enumerate)-    <|> TCCmd <$ reservedCase "Cmd"+  choice (map (\b -> TCBase b <$ reservedCS (baseTyName b)) enumerate)+    <|> TCCmd <$ reservedCS "Cmd"     <|> TCUser <$> tyName  -- | Close over a recursive type, replacing any bound occurrences@@ -127,7 +101,7 @@   s :: TypeF (Nat -> Type) -> Nat -> Type   s = \case     TyRecF y ty -> Fix . TyRecF y . ty . NS-    TyVarF y+    TyVarF orig y       | x == y -> Fix . TyRecVarF-      | otherwise -> const (Fix (TyVarF y))+      | otherwise -> const (Fix (TyVarF orig y))     fty -> \i -> Fix (fmap ($ i) fty)
+ src/swarm-lang/Swarm/Language/Parser/Value.hs view
@@ -0,0 +1,92 @@+{-# LANGUAGE OverloadedStrings #-}++-- |+-- SPDX-License-Identifier: BSD-3-Clause+--+-- Parse values of the Swarm language, indexed by type, by running the+-- full swarm-lang parser and then checking that the result is a value+-- of the proper type.+module Swarm.Language.Parser.Value (readValue) where++import Control.Lens ((^.))+import Data.Either.Extra (eitherToMaybe)+import Data.Text (Text)+import Data.Text qualified as T+import Swarm.Language.Context qualified as Ctx+import Swarm.Language.Key (parseKeyComboFull)+import Swarm.Language.Parser (readNonemptyTerm)+import Swarm.Language.Syntax+import Swarm.Language.Typecheck (checkTop)+import Swarm.Language.Types (Type, emptyTDCtx)+import Swarm.Language.Value+import Text.Megaparsec qualified as MP++readValue :: Type -> Text -> Maybe Value+readValue ty txt = do+  -- Try to strip off a prefix representing a printable entity.  Look+  -- for the first colon or double quote.  We will ignore a colon if a+  -- double quote comes before it, because a colon could legitimately+  -- occur in a formatted Text value, e.g. "\"hi: there\"".  Otherwise,+  -- strip off anything occurring before the first colon.+  --+  -- Note, this would break if we ever had a printable entity whose+  -- name contains a colon; printing on such an entity would yield+  -- entity names like "Magic: The Gathering: 6" for which `read`, as+  -- implemented here, would not work correctly. However, that seems+  -- unlikely.+  let firstUnquotedColon = T.dropWhile (\c -> c /= ':' && c /= '"') txt+  let txt' = case T.uncons firstUnquotedColon of+        Nothing -> txt+        Just ('"', _) -> txt+        Just (':', t) -> t+        _ -> txt+  s <- eitherToMaybe $ readNonemptyTerm txt'+  _ <- eitherToMaybe $ checkTop Ctx.empty Ctx.empty emptyTDCtx s ty+  toValue $ s ^. sTerm++toValue :: Term -> Maybe Value+toValue = \case+  TUnit -> Just VUnit+  TDir d -> Just $ VDir d+  TInt n -> Just $ VInt n+  TText t -> Just $ VText t+  TBool b -> Just $ VBool b+  TApp (TConst c) t2 -> case c of+    Neg -> toValue t2 >>= negateInt+    Inl -> VInj False <$> toValue t2+    Inr -> VInj True <$> toValue t2+    Key -> do+      VText k <- toValue t2+      VKey <$> eitherToMaybe (MP.runParser parseKeyComboFull "" k)+    _ -> Nothing+  TPair t1 t2 -> VPair <$> toValue t1 <*> toValue t2+  TRcd m -> VRcd <$> traverse (>>= toValue) m+  TParens t -> toValue t+  -- List the other cases explicitly, instead of a catch-all, so that+  -- we will get a warning if we ever add new constructors in the+  -- future+  TConst {} -> Nothing+  TAntiInt {} -> Nothing+  TAntiText {} -> Nothing+  TRequire {} -> Nothing+  TStock {} -> Nothing+  TRequirements {} -> Nothing+  TVar {} -> Nothing+  TLam {} -> Nothing+  TApp {} -> Nothing+  TLet {} -> Nothing+  TTydef {} -> Nothing+  TBind {} -> Nothing+  TDelay {} -> Nothing+  TProj {} -> Nothing+  TAnnotate {} -> Nothing+  TSuspend {} -> Nothing++-- TODO(#2232): in order to get `read` to work for delay, function,+-- and/or command types, we will need to handle a few more of the+-- above cases, e.g. TConst, TLam, TApp, TLet, TBind, TDelay.++negateInt :: Value -> Maybe Value+negateInt = \case+  VInt n -> Just (VInt (-n))+  _ -> Nothing
src/swarm-lang/Swarm/Language/Pipeline.hs view
@@ -28,12 +28,11 @@ import Swarm.Language.Context qualified as Ctx import Swarm.Language.Elaborate import Swarm.Language.Parser (readTerm)-import Swarm.Language.Pretty import Swarm.Language.Requirements.Type (ReqCtx) import Swarm.Language.Syntax import Swarm.Language.Typecheck import Swarm.Language.Types (TCtx)-import Swarm.Language.Value (Env, envReqs, envTydefs, envTypes)+import Swarm.Language.Value (Env, emptyEnv, envReqs, envTydefs, envTypes)  processTermEither :: Text -> Either Text TSyntax processTermEither t = case processTerm t of@@ -50,11 +49,11 @@ --   Return either the end result (or @Nothing@ if the input was only --   whitespace) or a pretty-printed error message. processTerm :: Text -> Either Text (Maybe TSyntax)-processTerm = processTerm' mempty+processTerm = processTerm' emptyEnv  -- | Like 'processTerm', but use a term that has already been parsed. processParsedTerm :: Syntax -> Either ContextualTypeErr TSyntax-processParsedTerm = processParsedTerm' mempty+processParsedTerm = processParsedTerm' emptyEnv  -- | Like 'processTerm', but use explicit starting contexts. processTerm' :: Env -> Text -> Either Text (Maybe TSyntax)@@ -78,7 +77,7 @@ extractTCtx (Syntax' _ t _ _) = extractTCtxTerm t  where   extractTCtxTerm = \case-    SLet _ _ (LV _ x) mty _ _ t2 -> maybe id (Ctx.addBinding x) mty (extractTCtx t2)+    SLet _ _ (LV _ x) _ mty _ _ t2 -> maybe id (Ctx.addBinding x) mty (extractTCtx t2)     SBind mx _ mty _ c1 c2 ->       maybe         id@@ -95,7 +94,7 @@ extractReqCtx (Syntax' _ t _ _) = extractReqCtxTerm t  where   extractReqCtxTerm = \case-    SLet _ _ (LV _ x) _ mreq _ t2 -> maybe id (Ctx.addBinding x) mreq (extractReqCtx t2)+    SLet _ _ (LV _ x) _ _ mreq _ t2 -> maybe id (Ctx.addBinding x) mreq (extractReqCtx t2)     SBind mx _ _ mreq c1 c2 ->       maybe         id
src/swarm-lang/Swarm/Language/Pipeline/QQ.hs view
@@ -12,8 +12,8 @@ import Swarm.Language.Parser.Term (parseTerm) import Swarm.Language.Parser.Util (fully) import Swarm.Language.Pipeline-import Swarm.Language.Pretty import Swarm.Language.Syntax+import Swarm.Language.Typecheck (prettyTypeErrText) import Swarm.Language.Types (Polytype) import Swarm.Util (failT, liftText) import Witch (from)@@ -38,12 +38,7 @@ quoteTermExp :: String -> TH.ExpQ quoteTermExp s = do   loc <- TH.location-  let pos =-        ( TH.loc_filename loc-        , fst (TH.loc_start loc)-        , snd (TH.loc_start loc)-        )-  parsed <- runParserTH pos (fully sc parseTerm) s+  parsed <- runParserTH loc (fully sc parseTerm) s   case processParsedTerm parsed of     Left err -> failT [prettyTypeErrText (from s) err]     Right ptm -> dataToExpQ ((fmap liftText . cast) `extQ` antiTermExp) ptm
− src/swarm-lang/Swarm/Language/Pretty.hs 
@@ -1,603 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE PatternSynonyms #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE ViewPatterns #-}---- |--- SPDX-License-Identifier: BSD-3-Clause------ Pretty-printing for the Swarm language.-module Swarm.Language.Pretty where--import Control.Lens.Combinators (pattern Empty)-import Control.Monad.Free (Free (..))-import Data.Bool (bool)-import Data.Fix-import Data.Foldable qualified as F-import Data.List.NonEmpty ((<|))-import Data.List.NonEmpty qualified as NE-import Data.Map.Strict qualified as M-import Data.Sequence qualified as Seq-import Data.Set (Set)-import Data.Set qualified as S-import Data.String (fromString)-import Data.Text (Text)-import Data.Text qualified as T-import Prettyprinter-import Prettyprinter.Render.String qualified as RS-import Prettyprinter.Render.Text qualified as RT-import Swarm.Effect.Unify (UnificationError (..))-import Swarm.Language.Capability-import Swarm.Language.Context-import Swarm.Language.Kindcheck (KindError (..))-import Swarm.Language.Parser.Util (getLocRange)-import Swarm.Language.Syntax-import Swarm.Language.Syntax.Direction-import Swarm.Language.Typecheck-import Swarm.Language.Types-import Swarm.Util (number, showEnum, showLowT, unsnocNE)-import Text.Show.Unicode (ushow)-import Witch----------------------------------------------------------------- PrettyPrec class + utilities---- | Type class for things that can be pretty-printed, given a---   precedence level of their context.-class PrettyPrec a where-  prettyPrec :: Int -> a -> Doc ann -- can replace with custom ann type later if desired---- | Pretty-print a thing, with a context precedence level of zero.-ppr :: (PrettyPrec a) => a -> Doc ann-ppr = prettyPrec 0---- | Render a pretty-printed document as @Text@.-docToText :: Doc a -> Text-docToText = RT.renderStrict . layoutPretty defaultLayoutOptions---- | Render a pretty-printed document as @Text@.---   This function consumes number of allowed characters in a---   line before introducing a line break. In other words, it---   expects the space of the layouter to be supplied.-docToTextWidth :: Doc a -> Int -> Text-docToTextWidth doc layoutWidth =-  RT.renderStrict $ layoutPretty (LayoutOptions (AvailablePerLine layoutWidth 1.0)) doc---- | Pretty-print something and render it as @Text@.-prettyText :: (PrettyPrec a) => a -> Text-prettyText = docToText . ppr---- | Pretty-print something and render it as @Text@.---   This is different than @prettyText@ in the sense that it also---   consumes number of allowed characters in a line before introducing---   a line break.-prettyTextWidth :: (PrettyPrec a) => a -> Int -> Text-prettyTextWidth = docToTextWidth . ppr---- | Pretty-print something and render it as (preferably) one line @Text@.-prettyTextLine :: (PrettyPrec a) => a -> Text-prettyTextLine = RT.renderStrict . layoutPretty (LayoutOptions Unbounded) . group . ppr---- | Render a pretty-printed document as a @String@.-docToString :: Doc a -> String-docToString = RS.renderString . layoutPretty defaultLayoutOptions---- | Pretty-print something and render it as a @String@.-prettyString :: (PrettyPrec a) => a -> String-prettyString = docToString . ppr---- | Optionally surround a document with parentheses depending on the---   @Bool@ argument and if it does not fit on line, indent the lines,---   with the parens on separate lines.-pparens :: Bool -> Doc ann -> Doc ann-pparens True = group . encloseWithIndent 2 lparen rparen-pparens False = id---- | Same as pparens but does not indent the lines. Only encloses---   the document with parantheses.-pparens' :: Bool -> Doc ann -> Doc ann-pparens' True = group . enclose lparen rparen-pparens' False = id--encloseWithIndent :: Int -> Doc ann -> Doc ann -> Doc ann -> Doc ann-encloseWithIndent i l r = nest i . enclose (l <> line') (nest (-2) $ line' <> r)---- | Surround a document with backticks.-bquote :: Doc ann -> Doc ann-bquote = group . enclose "`" "`"---- | Turn a 'Show' instance into a @Doc@, lowercasing it in the---   process.-prettyShowLow :: Show a => a -> Doc ann-prettyShowLow = pretty . showLowT---- | An invitation to report an error as a bug.-reportBug :: Doc ann-reportBug = "This should never happen; please report this as a bug: https://github.com/swarm-game/swarm/issues/new"------------------------------------------------------- Bullet lists--data Prec a = Prec Int a--data BulletList i = BulletList-  { bulletListHeader :: forall a. Doc a-  , bulletListItems :: [i]-  }--instance (PrettyPrec i) => PrettyPrec (BulletList i) where-  prettyPrec _ (BulletList hdr items) =-    nest 2 . vcat $ hdr : map (("-" <+>) . ppr) items----------------------------------------------------------------- PrettyPrec instances for terms, types, etc.--instance PrettyPrec Text where-  prettyPrec _ = pretty--instance PrettyPrec BaseTy where-  prettyPrec _ = pretty . drop 1 . show--instance PrettyPrec IntVar where-  prettyPrec _ = pretty . mkVarName "u"---- | We can use the 'Wildcard' value to replace unification variables---   when we don't care about them, e.g. to print out the shape of a---   type like @(_ -> _) * _@-data Wildcard = Wildcard-  deriving (Eq, Ord, Show)--instance PrettyPrec Wildcard where-  prettyPrec _ _ = "_"--instance PrettyPrec TyCon where-  prettyPrec _ = \case-    TCBase b -> ppr b-    TCCmd -> "Cmd"-    TCDelay -> "Delay"-    TCSum -> "Sum"-    TCProd -> "Prod"-    TCFun -> "Fun"-    TCUser t -> pretty t---- | Split a function type chain, so that we can pretty print---   the type parameters aligned on each line when they don't fit.-class UnchainableFun t where-  unchainFun :: t -> NE.NonEmpty t--instance UnchainableFun Type where-  unchainFun (a :->: ty) = a <| unchainFun ty-  unchainFun ty = pure ty--instance UnchainableFun (Free TypeF ty) where-  unchainFun (Free (TyConF TCFun [ty1, ty2])) = ty1 <| unchainFun ty2-  unchainFun ty = pure ty--instance (PrettyPrec (t (Fix t))) => PrettyPrec (Fix t) where-  prettyPrec p = prettyPrec p . unFix--instance (PrettyPrec (t (Free t v)), PrettyPrec v) => PrettyPrec (Free t v) where-  prettyPrec p (Free t) = prettyPrec p t-  prettyPrec p (Pure v) = prettyPrec p v--instance (UnchainableFun t, PrettyPrec t, SubstRec t) => PrettyPrec (TypeF t) where-  prettyPrec p = \case-    TyVarF v -> pretty v-    TyRcdF m -> brackets $ hsep (punctuate "," (map prettyBinding (M.assocs m)))-    -- Special cases for type constructors with special syntax.-    -- Always use parentheses around sum and product types, see #1625-    TyConF TCSum [ty1, ty2] ->-      pparens (p > 0) $-        prettyPrec 2 ty1 <+> "+" <+> prettyPrec 2 ty2-    TyConF TCProd [ty1, ty2] ->-      pparens (p > 0) $-        prettyPrec 2 ty1 <+> "*" <+> prettyPrec 2 ty2-    TyConF TCDelay [ty] -> braces $ ppr ty-    TyConF TCFun [ty1, ty2] ->-      let (iniF, lastF) = unsnocNE $ ty1 <| unchainFun ty2-          funs = (prettyPrec 2 <$> iniF) <> [prettyPrec 1 lastF]-          inLine l r = l <+> "->" <+> r-          multiLine l r = l <+> "->" <> softline <> r-       in pparens' (p > 1) . align $-            flatAlt (concatWith multiLine funs) (concatWith inLine funs)-    TyRecF x ty ->-      pparens (p > 0) $-        "rec" <+> pretty x <> "." <+> prettyPrec 0 (substRec (TyVarF x) ty NZ)-    -- This case shouldn't be possible, since TyRecVar should only occur inside a TyRec,-    -- and pretty-printing the TyRec (above) will substitute a variable name for-    -- any bound TyRecVars before recursing.-    TyRecVarF i -> pretty (show (natToInt i))-    -- Fallthrough cases for type constructor application.  Handles base-    -- types, Cmd, user-defined types, or ill-kinded things like 'Int-    -- Bool'.-    TyConF c [] -> ppr c-    TyConF c tys -> pparens (p > 9) $ ppr c <+> hsep (map (prettyPrec 10) tys)--instance PrettyPrec Polytype where-  prettyPrec _ (Forall [] t) = ppr t-  prettyPrec _ (Forall xs t) = hsep ("∀" : map pretty xs) <> "." <+> ppr t--instance PrettyPrec UPolytype where-  prettyPrec _ (Forall [] t) = ppr t-  prettyPrec _ (Forall xs t) = hsep ("∀" : map pretty xs) <> "." <+> ppr t--instance (PrettyPrec t) => PrettyPrec (Ctx t) where-  prettyPrec _ Empty = emptyDoc-  prettyPrec _ (assocs -> bs) = brackets (hsep (punctuate "," (map prettyBinding bs)))--prettyBinding :: (Pretty a, PrettyPrec b) => (a, b) -> Doc ann-prettyBinding (x, ty) = pretty x <> ":" <+> ppr ty--instance PrettyPrec Direction where-  prettyPrec _ = pretty . directionSyntax--instance PrettyPrec Capability where-  prettyPrec _ c = pretty $ T.toLower (from (NE.tail $ showEnum c))--instance PrettyPrec Const where-  prettyPrec p c = pparens (p > fixity (constInfo c)) $ pretty . syntax . constInfo $ c---- | Pretty-print a syntax node with comments.-instance PrettyPrec (Syntax' ty) where-  prettyPrec p (Syntax' _ t (Comments before after) _) = case before of-    Empty -> t'-    _ ->-      -- Print out any comments before the node, with a blank line before-      mconcat-        [ hardline-        , vsep (map ppr (F.toList before))-        , hardline-        , t'-        ]-   where-    -- Print the node itself, possibly with suffix comments on the same line-    t' = case Seq.viewr after of-      Seq.EmptyR -> prettyPrec p t-      _ Seq.:> lst -> case commentType lst of-        -- Output a newline after a line comment, but not after a block comment-        BlockComment -> tWithComments-        LineComment -> tWithComments <> hardline-     where-      -- The pretty-printed node with suffix comments-      tWithComments = prettyPrec p t <+> hsep (map ppr (F.toList after))--instance PrettyPrec Comment where-  prettyPrec _ (Comment _ LineComment _ txt) = "//" <> pretty txt-  prettyPrec _ (Comment _ BlockComment _ txt) = "/*" <> pretty txt <> "*/"--instance PrettyPrec (Term' ty) where-  prettyPrec p = \case-    TUnit -> "()"-    TConst c -> prettyPrec p c-    TDir d -> ppr d-    TInt n -> pretty n-    TAntiInt v -> "$int:" <> pretty v-    TText s -> fromString (ushow s)-    TAntiText v -> "$str:" <> pretty v-    TBool b -> bool "false" "true" b-    TRobot r -> "<a" <> pretty r <> ">"-    TRef r -> "@" <> pretty r-    TRequireDevice d -> pparens (p > 10) $ "require" <+> ppr @Term (TText d)-    TRequire n e -> pparens (p > 10) $ "require" <+> pretty n <+> ppr @Term (TText e)-    SRequirements _ e -> pparens (p > 10) $ "requirements" <+> ppr e-    TVar s -> pretty s-    SDelay (Syntax' _ (TConst Noop) _ _) -> "{}"-    SDelay t -> group . encloseWithIndent 2 lbrace rbrace $ ppr t-    t@SPair {} -> prettyTuple t-    t@SLam {} ->-      pparens (p > 9) $-        prettyLambdas t-    -- Special handling of infix operators - ((+) 2) 3 --> 2 + 3-    SApp t@(Syntax' _ (SApp (Syntax' _ (TConst c) _ _) l) _ _) r ->-      let ci = constInfo c-          pC = fixity ci-       in case constMeta ci of-            ConstMBinOp assoc ->-              pparens (p > pC) $-                hsep-                  [ prettyPrec (pC + fromEnum (assoc == R)) l-                  , ppr c-                  , prettyPrec (pC + fromEnum (assoc == L)) r-                  ]-            _ -> prettyPrecApp p t r-    SApp t1 t2 -> case t1 of-      Syntax' _ (TConst c) _ _ ->-        let ci = constInfo c-            pC = fixity ci-         in case constMeta ci of-              ConstMUnOp P -> pparens (p > pC) $ ppr t1 <> prettyPrec (succ pC) t2-              ConstMUnOp S -> pparens (p > pC) $ prettyPrec (succ pC) t2 <> ppr t1-              _ -> prettyPrecApp p t1 t2-      _ -> prettyPrecApp p t1 t2-    SLet LSLet _ (LV _ x) mty _ t1 t2 ->-      sep-        [ prettyDefinition "let" x mty t1 <+> "in"-        , ppr t2-        ]-    SLet LSDef _ (LV _ x) mty _ t1 t2 ->-      mconcat $-        prettyDefinition "def" x mty t1 <+> "end"-          : case t2 of-            Syntax' _ (TConst Noop) _ _ -> []-            _ -> [hardline, hardline, ppr t2]-    STydef (LV _ x) pty _ t1 ->-      mconcat $-        prettyTydef x pty-          : case t1 of-            Syntax' _ (TConst Noop) _ _ -> []-            _ -> [hardline, hardline, ppr t1]-    SBind Nothing _ _ _ t1 t2 ->-      pparens (p > 0) $-        prettyPrec 1 t1 <> ";" <> line <> prettyPrec 0 t2-    SBind (Just (LV _ x)) _ _ _ t1 t2 ->-      pparens (p > 0) $-        pretty x <+> "<-" <+> prettyPrec 1 t1 <> ";" <> line <> prettyPrec 0 t2-    SRcd m -> brackets $ hsep (punctuate "," (map prettyEquality (M.assocs m)))-    SProj t x -> prettyPrec 11 t <> "." <> pretty x-    SAnnotate t pt ->-      pparens (p > 0) $-        prettyPrec 1 t <+> ":" <+> ppr pt-    SSuspend t ->-      pparens (p > 10) $-        "suspend" <+> prettyPrec 11 t--prettyEquality :: (Pretty a, PrettyPrec b) => (a, Maybe b) -> Doc ann-prettyEquality (x, Nothing) = pretty x-prettyEquality (x, Just t) = pretty x <+> "=" <+> ppr t--prettyDefinition :: Doc ann -> Var -> Maybe Polytype -> Syntax' ty -> Doc ann-prettyDefinition defName x mty t1 =-  nest 2 . sep $-    [ flatAlt-        (defHead <> group defType <+> eqAndLambdaLine)-        (defHead <> group defType' <+> defEqLambdas)-    , ppr defBody-    ]- where-  (defBody, defLambdaList) = unchainLambdas t1-  defHead = defName <+> pretty x-  defType = maybe "" (\ty -> ":" <+> flatAlt (line <> indent 2 (ppr ty)) (ppr ty)) mty-  defType' = maybe "" (\ty -> ":" <+> ppr ty) mty-  defEqLambdas = hsep ("=" : map prettyLambda defLambdaList)-  eqAndLambdaLine = if null defLambdaList then "=" else line <> defEqLambdas--prettyTydef :: Var -> Polytype -> Doc ann-prettyTydef x (Forall [] ty) = "tydef" <+> pretty x <+> "=" <+> ppr ty <+> "end"-prettyTydef x (Forall xs ty) = "tydef" <+> pretty x <+> hsep (map pretty xs) <+> "=" <+> ppr ty <+> "end"--prettyPrecApp :: Int -> Syntax' ty -> Syntax' ty -> Doc a-prettyPrecApp p t1 t2 =-  pparens (p > 10) $-    prettyPrec 10 t1 <+> prettyPrec 11 t2--appliedTermPrec :: Term -> Int-appliedTermPrec (TApp f _) = case f of-  TConst c -> fixity $ constInfo c-  _ -> appliedTermPrec f-appliedTermPrec _ = 10--prettyTuple :: Term' ty -> Doc a-prettyTuple = tupled . map ppr . unTuple . STerm . erase--prettyLambdas :: Term' ty -> Doc a-prettyLambdas t = hsep (prettyLambda <$> lms) <> softline <> ppr rest- where-  (rest, lms) = unchainLambdas (STerm (erase t))--unchainLambdas :: Syntax' ty -> (Syntax' ty, [(Var, Maybe Type)])-unchainLambdas = \case-  Syntax' _ (SLam (LV _ x) mty body) _ _ -> ((x, mty) :) <$> unchainLambdas body-  body -> (body, [])--prettyLambda :: (Pretty a1, PrettyPrec a2) => (a1, Maybe a2) -> Doc ann-prettyLambda (x, mty) = "\\" <> pretty x <> maybe "" ((":" <>) . ppr) mty <> "."----------------------------------------------------------------- Error messages---- | Format a 'ContextualTypeError' for the user and render it as---   @Text@.-prettyTypeErrText :: Text -> ContextualTypeErr -> Text-prettyTypeErrText code = docToText . prettyTypeErr code---- | Format a 'ContextualTypeError' for the user.-prettyTypeErr :: Text -> ContextualTypeErr -> Doc ann-prettyTypeErr code (CTE l tcStack te) =-  vcat-    [ teLoc <> ppr te-    , ppr (BulletList "" (filterTCStack tcStack))-    ]- where-  teLoc = case l of-    SrcLoc s e -> (showLoc . fst $ getLocRange code (s, e)) <> ": "-    NoLoc -> emptyDoc-  showLoc (r, c) = pretty r <> ":" <> pretty c---- | Filter the TCStack of extravagant Binds.-filterTCStack :: TCStack -> TCStack-filterTCStack tcStack = case tcStack of-  [] -> []-  t@(LocatedTCFrame _ (TCLet _)) : _ -> [t]-  t@(LocatedTCFrame _ TCBindR) : xs -> t : filterTCStack xs-  t@(LocatedTCFrame _ TCBindL) : xs -> t : filterTCStack xs--instance PrettyPrec TypeErr where-  prettyPrec _ = \case-    UnificationErr ue -> ppr ue-    KindErr ke -> ppr ke-    Mismatch Nothing (getJoin -> (ty1, ty2)) ->-      "Type mismatch: expected" <+> ppr ty1 <> ", but got" <+> ppr ty2-    Mismatch (Just t) (getJoin -> (ty1, ty2)) ->-      nest 2 . vcat $-        [ "Type mismatch:"-        , "From context, expected" <+> pprCode t <+> "to" <+> typeDescription Expected ty1 <> ","-        , "but it" <+> typeDescription Actual ty2-        ]-    LambdaArgMismatch (getJoin -> (ty1, ty2)) ->-      "Lambda argument has type annotation" <+> pprCode ty2 <> ", but expected argument type" <+> pprCode ty1-    FieldsMismatch (getJoin -> (expFs, actFs)) ->-      fieldMismatchMsg expFs actFs-    EscapedSkolem x ->-      "Skolem variable" <+> pretty x <+> "would escape its scope"-    UnboundVar x ->-      "Unbound variable" <+> pretty x-    DefNotTopLevel t ->-      "Definitions may only be at the top level:" <+> pprCode t-    CantInfer t ->-      vsep-        [ "Couldn't infer the type of term:" <+> pprCode t-        , reportBug-        ]-    CantInferProj t ->-      "Can't infer the type of a record projection:" <+> pprCode t-    UnknownProj x t ->-      "Record does not have a field with name" <+> pretty x <> ":" <+> pprCode t-    InvalidAtomic reason t ->-      "Invalid atomic block:" <+> ppr reason <> ":" <+> pprCode t-    Impredicative ->-      "Unconstrained unification type variables encountered, likely due to an impredicative type. This is a known bug; for more information see https://github.com/swarm-game/swarm/issues/351 ."-   where-    pprCode :: PrettyPrec a => a -> Doc ann-    pprCode = bquote . ppr--instance PrettyPrec UnificationError where-  prettyPrec _ = \case-    Infinite x uty ->-      vsep-        [ "Encountered infinite type" <+> ppr x <+> "=" <+> ppr uty <> "."-        , "Swarm will not infer recursive types; if you want a recursive type, add an explicit type annotation."-        ]-    UnifyErr ty1 ty2 ->-      "Can't unify" <+> ppr ty1 <+> "and" <+> ppr ty2-    UndefinedUserType ty ->-      "Undefined user type" <+> ppr ty-    UnexpandedRecTy ty ->-      vsep-        [ "Unexpanded recursive type" <+> ppr ty <+> "encountered in unifyF."-        , reportBug-        ]--instance PrettyPrec Arity where-  prettyPrec _ (Arity a) = pretty a--instance PrettyPrec KindError where-  prettyPrec _ = \case-    ArityMismatch c a tys ->-      nest 2 . vsep $-        [ "Kind error:"-        , hsep-            [ ppr c-            , "requires"-            , pretty a-            , "type"-            , pretty (number a "argument" <> ",")-            , "but was given"-            , pretty (length tys)-            ]-        ]-          ++ ["in the type:" <+> ppr (TyConApp c tys) | not (null tys)]-    UndefinedTyCon tc _ty -> "Undefined type" <+> ppr tc-    TrivialRecTy x ty ->-      nest 2 . vsep $-        [ "Encountered trivial recursive type" <+> ppr (TyRec x ty)-        , "Did you forget to use" <+> pretty x <+> "in the body of the type?"-        ]-    VacuousRecTy x ty ->-      nest 2 . vsep $-        [ "Encountered vacuous recursive type" <+> ppr (TyRec x ty)-        , "Recursive types must be productive, i.e. must not expand to themselves."-        ]---- | Given a type and its source, construct an appropriate description---   of it to go in a type mismatch error message.-typeDescription :: Source -> UType -> Doc a-typeDescription src ty-  | not (hasAnyUVars ty) =-      withSource src "have" "actually has" <+> "type" <+> bquote (ppr ty)-  | Just f <- isTopLevelConstructor ty =-      withSource src "be" "is actually" <+> tyNounPhrase f-  | otherwise =-      withSource src "have" "actually has" <+> "a type like" <+> bquote (ppr (fmap (const Wildcard) ty))---- | Check whether a type contains any unification variables at all.-hasAnyUVars :: UType -> Bool-hasAnyUVars = ucata (const True) or---- | Check whether a type consists of a top-level type constructor---   immediately applied to unification variables.-isTopLevelConstructor :: UType -> Maybe (TypeF ())-isTopLevelConstructor = \case-  Free (TyRcdF m) | all isPure m -> Just (TyRcdF M.empty)-  UTyConApp c ts | all isPure ts -> Just (TyConF c [])-  _ -> Nothing--isPure :: Free f a -> Bool-isPure (Pure {}) = True-isPure _ = False---- | Return an English noun phrase describing things with the given---   top-level type constructor.-tyNounPhrase :: TypeF () -> Doc a-tyNounPhrase = \case-  TyConF c _ -> tyConNounPhrase c-  TyVarF {} -> "a type variable"-  TyRcdF {} -> "a record"-  TyRecF {} -> "a recursive type"-  TyRecVarF {} -> "a recursive type variable"--tyConNounPhrase :: TyCon -> Doc a-tyConNounPhrase = \case-  TCBase b -> baseTyNounPhrase b-  TCCmd -> "a command"-  TCDelay -> "a delayed expression"-  TCSum -> "a sum"-  TCProd -> "a pair"-  TCFun -> "a function"-  TCUser t -> pretty t---- | Return an English noun phrase describing things with the given---   base type.-baseTyNounPhrase :: BaseTy -> Doc a-baseTyNounPhrase = \case-  BVoid -> "void"-  BUnit -> "the unit value"-  BInt -> "an integer"-  BText -> "text"-  BDir -> "a direction"-  BBool -> "a boolean"-  BActor -> "an actor"-  BKey -> "a key"---- | Generate an appropriate message when the sets of fields in two---   record types do not match, explaining which fields are extra and---   which are missing.-fieldMismatchMsg :: Set Var -> Set Var -> Doc a-fieldMismatchMsg expFs actFs =-  nest 2 . vcat $-    ["Field mismatch; record literal has:"]-      ++ ["- Extra field(s)" <+> prettyFieldSet extraFs | not (S.null extraFs)]-      ++ ["- Missing field(s)" <+> prettyFieldSet missingFs | not (S.null missingFs)]- where-  extraFs = actFs `S.difference` expFs-  missingFs = expFs `S.difference` actFs-  prettyFieldSet = hsep . punctuate "," . map (bquote . pretty) . S.toList--instance PrettyPrec InvalidAtomicReason where-  prettyPrec _ = \case-    TooManyTicks n -> "block could take too many ticks (" <> pretty n <> ")"-    AtomicDupingThing -> "def, let, and lambda are not allowed"-    NonSimpleVarType _ ty ->-      "reference to variable with non-simple type" <+> ppr (prettyTextLine ty)-    NestedAtomic -> "nested atomic block"-    LongConst -> "commands that can take multiple ticks to execute are not allowed"-    AtomicSuspend ->-      "encountered a suspend command inside an atomic block" <> hardline <> reportBug--instance PrettyPrec LocatedTCFrame where-  prettyPrec p (LocatedTCFrame _ f) = prettyPrec p f--instance PrettyPrec TCFrame where-  prettyPrec _ = \case-    TCLet x -> "While checking the definition of" <+> pretty x-    TCBindL -> "While checking the left-hand side of a semicolon"-    TCBindR -> "While checking the right-hand side of a semicolon"
src/swarm-lang/Swarm/Language/Requirements/Analysis.hs view
@@ -14,6 +14,7 @@ import Control.Algebra (Has, run) import Control.Carrier.Accum.Strict (execAccum) import Control.Carrier.Reader (runReader)+import Control.Carrier.Throw.Either (runThrow) import Control.Effect.Accum (Accum, add) import Control.Effect.Reader (Reader, ask, local) import Control.Monad (when)@@ -25,7 +26,9 @@ import Swarm.Language.Requirements.Type import Swarm.Language.Syntax import Swarm.Language.Syntax.Direction (isCardinal)+import Swarm.Language.TDVar (tdVarName) import Swarm.Language.Types+import Swarm.Util (applyWhen)  -- | Infer the requirements to execute/evaluate a term in a given --   context.@@ -63,6 +66,7 @@     TAntiText _ -> pure ()     TBool _ -> pure ()     TSuspend {} -> pure ()+    TType {} -> pure ()     -- It doesn't require any special capability to *inquire* about     -- the requirements of a term.     TRequirements _ _ -> pure ()@@ -70,8 +74,8 @@     -- constants using 'constCaps'.     TConst c -> forM_ (constCaps c) (add . singletonCap)     -- Simply record device or inventory requirements.-    TRequireDevice d -> add (singletonDev d)-    TRequire n e -> add (singletonInv n e)+    TRequire d -> add (singletonDev d)+    TStock n e -> add (singletonInv n e)     -- Note that a variable might not show up in the context, and     -- that's OK; if not, it just means using the variable requires     -- no special capabilities.@@ -100,15 +104,18 @@       add (singletonCap CLambda)       mapM_ typeRequirements mty       local @ReqCtx (Ctx.delete x) $ go t-    -- An application simply requires the union of the capabilities-    -- from the left- and right-hand sides.  This assumes that the-    -- argument will be used at least once by the function.+    -- Special case for 'use' with a device literal.+    TApp t1@(TConst Use) t2@(TText device) ->+      add (singletonDev device) *> go t1 *> go t2+    -- In general, an application simply requires the union of the+    -- capabilities from the left- and right-hand sides.  This assumes+    -- that the argument will be used at least once by the function.     TApp t1 t2 -> go t1 *> go t2     -- Similarly, for a let, we assume that the let-bound expression     -- will be used at least once in the body. We delete the let-bound     -- name from the context when recursing for the same reason as     -- lambda.-    TLet LSLet r x mty _ t1 t2 -> do+    TLet LSLet r x mty _ _ t1 t2 -> do       when r $ add (singletonCap CRecursion)       add (singletonCap CEnv)       mapM_ polytypeRequirements mty@@ -116,14 +123,14 @@     -- However, for def, we do NOT assume that the defined expression     -- will be used at least once in the body; it may not be executed     -- until later on, when the base robot has more capabilities.-    TLet LSDef r x mty _ t1 t2 -> do+    TLet LSDef r x mty _ _ t1 t2 -> do       add (singletonCap CEnv)       mapM_ polytypeRequirements mty       localReqCtx <- ask @ReqCtx       localTDCtx <- ask @TDCtx       let bodyReqs =-            (if r then (singletonCap CRecursion <>) else id)-              (requirements localTDCtx localReqCtx t1)+            applyWhen r (singletonCap CRecursion <>) $+              requirements localTDCtx localReqCtx t1       local @ReqCtx (Ctx.addBinding x bodyReqs) $ go t2     -- Using tydef requires CEnv, plus whatever the requirements are     -- for the type itself.@@ -140,7 +147,7 @@       -- symptom of the fact that typechecking, kind checking, and       -- requirements checking really all need to be done at the same       -- time during a single traversal of the term (see #231).-      local @TDCtx (Ctx.addBinding x (TydefInfo ty (Arity . length . ptVars $ ty))) (go t2)+      local @TDCtx (addBindingTD (tdVarName x) (TydefInfo ty (Arity . length . ptVars $ ty))) (go t2)     -- We also delete the name in a TBind, if any, while recursing on     -- the RHS.     TBind mx _ _ t1 t2 -> do@@ -156,12 +163,13 @@     TProj t _ -> add (singletonCap CRecord) *> go t     -- A type ascription doesn't change requirements     TAnnotate t ty -> go t *> polytypeRequirements ty+    TParens t -> go t  polytypeRequirements ::   (Has (Accum Requirements) sig m, Has (Reader TDCtx) sig m) =>-  Polytype ->+  Poly q Type ->   m ()-polytypeRequirements (Forall _ ty) = typeRequirements ty+polytypeRequirements = typeRequirements . ptBody  typeRequirements ::   (Has (Accum Requirements) sig m, Has (Reader TDCtx) sig m) =>@@ -172,11 +180,19 @@   go (Fix tyF) = goF tyF    goF = \case-    TyVarF _ -> pure ()+    TyVarF _ _ -> pure ()     TyConF (TCUser u) tys -> do       mapM_ go tys-      ty' <- expandTydef u tys-      go ty'+      res <- runThrow @ExpandTydefErr (expandTydef u tys)+      case res of+        -- If the user tycon is undefined, just return 0 requirements.+        -- This is not really correct---it should be some kind of+        -- error---but in theory it should be impossible for a user+        -- tycon to be undefined, and adding error propagation here+        -- would be annoying.  The undefined tycon can be caught+        -- somewhere else.+        Left _ -> pure ()+        Right ty' -> go ty'     TyConF c tys -> do       case c of         TCSum -> add (singletonCap CSum)
src/swarm-lang/Swarm/Language/Requirements/Type.hs view
@@ -30,13 +30,14 @@ import GHC.Generics (Generic) import Swarm.Language.Capability (Capability (..)) import Swarm.Language.Context (Ctx)+import Swarm.Language.Var  -- | A /requirement/ is something a robot must have when it is --   built. There are three types: --   - A robot can require a certain 'Capability', which should be fulfilled --     by equipping an appropriate device. --   - A robot can require a specific /device/, which should be equipped.---   - A robot can require some number of a specific entity in its inventory.+--   - A robot can stock some number of a specific entity in its inventory. data Requirement   = -- | Require a specific capability.  This must be fulfilled by     --   equipping an appropriate device.  Requiring the same@@ -53,7 +54,7 @@     --   Requiring the same device multiple times is the same as     --   requiring it once.     ReqDev Text-  | -- | Require a certain number of a specific entity to be available+  | -- | Stock a certain number of a specific entity to be available     --   in the inventory.  The same comments apply re: resolving the     --   entity name to an actual 'Swarm.Game.Entity.Entity'.     --@@ -61,7 +62,7 @@     --   of entity @"e"@ and later requiring 7 is the same as requiring     --   12.     ReqInv Int Text-  deriving (Eq, Ord, Show, Read, Generic, Hashable, Data, FromJSON, ToJSON)+  deriving (Eq, Ord, Show, Generic, Hashable, Data, FromJSON, ToJSON)  -- | It is tempting to define @Requirements = Set Requirement@, but --   that would be wrong, since two identical 'ReqInv' should have@@ -75,7 +76,7 @@   , devReqs :: Set Text   , invReqs :: Map Text Int   }-  deriving (Eq, Ord, Show, Data, Generic, FromJSON, ToJSON)+  deriving (Eq, Ord, Show, Data, Generic, FromJSON, ToJSON, Hashable)  instance Semigroup Requirements where   Requirements c1 d1 i1 <> Requirements c2 d2 i2 =@@ -110,4 +111,4 @@  -- | A requirement context records the requirements for the --   definitions bound to variables.-type ReqCtx = Ctx Requirements+type ReqCtx = Ctx Var Requirements
src/swarm-lang/Swarm/Language/Syntax.hs view
@@ -31,7 +31,8 @@    -- * SrcLoc   SrcLoc (..),-  srcLocBefore,+  srcLocStartsBefore,+  srcLocEndsBefore,   noLoc,    -- * Comments@@ -54,7 +55,8 @@   USyntax,   pattern Syntax,   pattern CSyntax,-  LocVar (..),+  Located (..),+  LocVar,   LetSyntax (..),   pattern STerm,   pattern TRequirements,@@ -70,10 +72,10 @@   pattern TProj,   pattern TAnnotate,   pattern TSuspend,+  pattern TParens,    -- * Terms   Var,-  DelayType (..),   Term' (..),   Term,   TTerm,@@ -103,5 +105,6 @@ import Swarm.Language.Syntax.Constants import Swarm.Language.Syntax.Loc import Swarm.Language.Syntax.Pattern+import Swarm.Language.Syntax.Pretty () import Swarm.Language.Syntax.Util import Swarm.Language.Types
src/swarm-lang/Swarm/Language/Syntax/AST.hs view
@@ -5,18 +5,18 @@ -- | -- SPDX-License-Identifier: BSD-3-Clause ----- Types represeting the surface syntax and terms for Swarm programming language.+-- Types representing the surface syntax and terms for Swarm programming language. module Swarm.Language.Syntax.AST (   Syntax' (..),   LetSyntax (..),   Term' (..),-  DelayType (..), ) where  import Control.Lens (Plated (..)) import Data.Aeson.Types hiding (Key) import Data.Data (Data) import Data.Data.Lens (uniplate)+import Data.Hashable (Hashable) import Data.Map.Strict (Map) import Data.Text (Text) import GHC.Generics (Generic)@@ -25,6 +25,7 @@ import Swarm.Language.Syntax.Constants import Swarm.Language.Syntax.Direction import Swarm.Language.Syntax.Loc+import Swarm.Language.TDVar (TDVar) import Swarm.Language.Types  ------------------------------------------------------------@@ -38,17 +39,21 @@   , _sComments :: Comments   , _sType :: ty   }-  deriving (Eq, Show, Functor, Foldable, Traversable, Data, Generic)+  deriving (Eq, Show, Functor, Foldable, Traversable, Data, Generic, Hashable)  instance Data ty => Plated (Syntax' ty) where   plate = uniplate  -- | A @let@ expression can be written either as @let x = e1 in e2@ or --   as @def x = e1 end; e2@. This enumeration simply records which it---   was so that we can pretty-print appropriatly.+--   was so that we can pretty-print appropriately. data LetSyntax = LSLet | LSDef-  deriving (Eq, Ord, Show, Bounded, Enum, Generic, Data, ToJSON, FromJSON)+  deriving (Eq, Ord, Show, Bounded, Enum, Generic, Data, Hashable, ToJSON, FromJSON) +------------------------------------------------------------+-- Term: basic syntax tree+------------------------------------------------------------+ -- | Terms of the Swarm language. data Term' ty   = -- | The unit value.@@ -67,6 +72,8 @@     TAntiText Text   | -- | A Boolean literal.     TBool Bool+  | -- | An antiquoted Haskell variable name of type Syntax.+    TAntiSyn Text   | -- | A robot reference.  These never show up in surface syntax, but are     --   here so we can factor pretty-printing for Values through     --   pretty-printing for Terms.@@ -75,9 +82,9 @@     --   but are here to facilitate pretty-printing.     TRef Int   | -- | Require a specific device to be installed.-    TRequireDevice Text+    TRequire Text   | -- | Require a certain number of an entity.-    TRequire Int Text+    TStock Int Text   | -- | Primitive command to log requirements of a term.  The Text     --   field is to store the unaltered original text of the term, for use     --   in displaying the log message (since once we get to execution time the@@ -97,14 +104,15 @@     --   annotation on the variable. The @Bool@ indicates whether     --   it is known to be recursive.     ---    --   The @Maybe Requirements@ field is only for annotating the-    --   requirements of a definition after typechecking; there is no-    --   way to annotate requirements in the surface syntax.-    SLet LetSyntax Bool LocVar (Maybe Polytype) (Maybe Requirements) (Syntax' ty) (Syntax' ty)+    --   The @Maybe Polytype@ and @Maybe Requirements@ fields are only+    --   for annotating the requirements of a definition after+    --   typechecking; there is no way to annotate requirements in the+    --   surface syntax.+    SLet LetSyntax Bool LocVar (Maybe RawPolytype) (Maybe Polytype) (Maybe Requirements) (Syntax' ty) (Syntax' ty)   | -- | A type synonym definition.  Note that this acts like a @let@     --   (just like @def@), /i.e./ the @Syntax' ty@ field is the local     --   context over which the type definition is in scope.-    STydef LocVar Polytype (Maybe TydefInfo) (Syntax' ty)+    STydef (Located TDVar) Polytype (Maybe TydefInfo) (Syntax' ty)   | -- | A monadic bind for commands, of the form @c1 ; c2@ or @x <- c1; c2@.     --     --   The @Maybe ty@ field is a place to stash the inferred type of@@ -133,10 +141,17 @@   | -- | Record projection @e.x@     SProj (Syntax' ty) Var   | -- | Annotate a term with a type-    SAnnotate (Syntax' ty) Polytype+    SAnnotate (Syntax' ty) RawPolytype   | -- | Run the given command, then suspend and wait for a new REPL     --   input.     SSuspend (Syntax' ty)+  | -- | An explicit representation of parentheses in the input.  We+    --   need this to be able to print formatted code with parentheses+    --   and comments preserved, but we get rid of them during+    --   elaboration.+    SParens (Syntax' ty)+  | -- | A type literal.+    TType Type   deriving     ( Eq     , Show@@ -144,6 +159,7 @@     , Foldable     , Data     , Generic+    , Hashable     , -- | The Traversable instance for Term (and for Syntax') is used during       -- typechecking: during intermediate type inference, many of the type       -- annotations placed on AST nodes will have unification variables in@@ -157,24 +173,3 @@  instance Data ty => Plated (Term' ty) where   plate = uniplate----------------------------------------------------------------- Basic terms----------------------------------------------------------------- | Different runtime behaviors for delayed expressions.-data DelayType-  = -- | A simple delay, implemented via a (non-memoized) @VDelay@-    --   holding the delayed expression.-    SimpleDelay-  | -- | A memoized delay, implemented by allocating a mutable cell-    --   with the delayed expression and returning a reference to it.-    --   When the @Maybe Var@ is @Just@, a recursive binding of the-    --   variable with a reference to the delayed expression will be-    --   provided while evaluating the delayed expression itself. Note-    --   that there is no surface syntax for binding a variable within-    --   a recursive delayed expression; the only way we can get-    --   @Just@ here is when we automatically generate a delayed-    --   expression while interpreting a recursive @let@ or @def@.-    MemoizedDelay (Maybe Var)-  deriving (Eq, Show, Data, Generic, FromJSON, ToJSON)
src/swarm-lang/Swarm/Language/Syntax/Comments.hs view
@@ -25,19 +25,22 @@ import Data.Aeson qualified as A import Data.Aeson.Types hiding (Key) import Data.Data (Data)+import Data.Hashable (Hashable) import Data.Sequence (Seq)-import Data.Text hiding (filter, length, map)+import Data.Text (Text) import GHC.Generics (Generic)+import Prettyprinter (pretty) import Swarm.Language.Syntax.Loc+import Swarm.Pretty (PrettyPrec (..))  -- | Line vs block comments. data CommentType = LineComment | BlockComment-  deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Data, ToJSON, FromJSON)+  deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Data, Hashable, ToJSON, FromJSON)  -- | Was a comment all by itself on a line, or did it occur after some --   other tokens on a line? data CommentSituation = StandaloneComment | SuffixComment-  deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Data, ToJSON, FromJSON)+  deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Data, Hashable, ToJSON, FromJSON)  -- | Test whether a comment is a standalone comment or not. isStandalone :: Comment -> Bool@@ -53,15 +56,19 @@   , commentSituation :: CommentSituation   , commentText :: Text   }-  deriving (Eq, Show, Generic, Data, ToJSON, FromJSON)+  deriving (Eq, Show, Generic, Data, ToJSON, FromJSON, Hashable) +instance PrettyPrec Comment where+  prettyPrec _ (Comment _ LineComment _ txt) = "//" <> pretty txt+  prettyPrec _ (Comment _ BlockComment _ txt) = "/*" <> pretty txt <> "*/"+ -- | Comments which can be attached to a particular AST node.  Some --   comments come textually before the node and some come after. data Comments = Comments   { _beforeComments :: Seq Comment   , _afterComments :: Seq Comment   }-  deriving (Eq, Show, Generic, Data)+  deriving (Eq, Show, Generic, Data, Hashable)  makeLenses ''Comments
src/swarm-lang/Swarm/Language/Syntax/Constants.hs view
@@ -29,14 +29,17 @@  import Data.Aeson.Types hiding (Key) import Data.Data (Data)+import Data.Hashable (Hashable) import Data.Int (Int32) import Data.List.Extra (enumerate) import Data.Set (Set) import Data.Set qualified as Set-import Data.Text hiding (filter, length, map)+import Data.Text (Text) import Data.Text qualified as T import GHC.Generics (Generic)+import Prettyprinter (pretty) import Swarm.Language.Syntax.CommandMetadata+import Swarm.Pretty (PrettyPrec (..), pparens) import Swarm.Util (showT)  ------------------------------------------------------------@@ -143,15 +146,18 @@     Scout   | -- | Get the current x, y coordinates     Whereami-  | -- | 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-    Structure+  | -- | Get the current subworld and x, y coordinates+    LocateMe+  | -- | Get the list of x, y coordinates of the waypoints for a given name+    Waypoints+  | -- | Get the list of x, y coordinates of the southwest corner of all+    --   constructed structures of a given name+    Structures   | -- | Get the width and height of a structure template     Floorplan   | -- | Answer whether a given entity has the given tag     HasTag-  | -- | Cycle through the entity names that are labeled with a given tag+  | -- | Get the list of entity names that are labeled with a given tag     TagMembers   | -- | Locate the closest instance of a given entity within the rectangle     -- specified by opposite corners, relative to the current location.@@ -212,14 +218,12 @@     Inr   | -- | Case analysis on a sum type.     Case-  | -- | First projection.-    Fst-  | -- | Second projection.-    Snd+  | -- | Pair eliminator.+    Match   | -- | Force a delayed evaluation.     Force-  | -- | Return for the cmd monad.-    Return+  | -- | Pure for the cmd monad.+    Pure   | -- | Try/catch block     Try   | -- | Undefined@@ -266,6 +270,12 @@      -- | Turn an arbitrary value into a string     Format+  | -- | Try to turn a string into a value+    Read+  | -- | Print a string onto a printable surface+    Print+  | -- | Erase a printable surface+    Erase   | -- | Concatenate string values     Concat   | -- | Count number of characters.@@ -301,6 +311,8 @@      -- | 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.@@ -309,8 +321,11 @@     RobotNumbered   | -- | Check if an entity is known.     Knows-  deriving (Eq, Ord, Enum, Bounded, Data, Show, Generic, FromJSON, ToJSON, FromJSONKey, ToJSONKey)+  deriving (Eq, Ord, Enum, Bounded, Data, Show, Generic, Hashable, FromJSON, ToJSON, FromJSONKey, ToJSONKey) +instance PrettyPrec Const where+  prettyPrec p c = pparens (p > fixity (constInfo c)) $ pretty . syntax . constInfo $ c+ allConst :: [Const] allConst = enumerate @@ -615,7 +630,7 @@   Use ->     command 2 long . doc (Set.singleton $ Mutation EntityChange) "Use one entity upon another." $       [ "Which entities you can `use` with others depends on the available recipes."-      , "The object being used must be a 'required' entity in a recipe."+      , "The object being used must be a 'stocked' entity in a recipe."       ]   Build ->     command 1 long . doc (Set.singleton $ Mutation $ RobotChange ExistenceChange) "Construct a new robot." $@@ -642,7 +657,7 @@           <> "that is done automatically once you have a listening device equipped."       , "Note that you can see the messages either in your logger device or the message panel."       ]-  Log -> command 1 short $ shortDoc (Set.singleton $ Mutation LogEmission) "Log the string in the robot's logger."+  Log -> command 1 Intangible $ shortDoc (Set.singleton $ Mutation LogEmission) "Log the string in the robot's logger."   View ->     command 1 short . doc (Set.singleton $ Query $ Sensing RobotSensing) "View the given actor." $       [ "This will recenter the map on the target robot and allow its inventory and logs to be inspected."@@ -672,36 +687,33 @@       shortDoc         (Set.singleton $ Query $ Sensing RobotSensing)         "Get the current x and 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."-      , "Since waypoint names can have plural multiplicity, returns a tuple of (count, (x, y))."-      , "The supplied index will be wrapped automatically, modulo the waypoint count."-      , "A robot can use the count to know whether they have iterated over the full waypoint circuit."-      ]-  Structure ->-    command 2 Intangible . doc (Set.singleton $ Query $ Sensing EntitySensing) "Get the x, y coordinates of the southwest corner of a constructed structure, by name and index" $-      [ "The outermost type of the return value indicates whether any structure of such name exists."-      , "Since structures can have multiple occurrences, returns a tuple of (count, (x, y))."-      , "The supplied index will be wrapped automatically, modulo the structure count."-      , "A robot can use the count to know whether they have iterated over the full structure list."+  LocateMe ->+    command 0 Intangible $+      shortDoc+        (Set.singleton $ Query $ Sensing RobotSensing)+        "Get the current subworld and x, y coordinates."+  Waypoints ->+    function 1 . doc (Set.singleton $ Query APriori) "Get the list of x, y coordinates of a named waypoint" $+      [ "Returns only the waypoints in the same subworld as the calling robot."+      , "Since waypoint names can have plural multiplicity, returns a list of (x, y) coordinates)."       ]+  Structures ->+    command 1 Intangible . doc (Set.singleton $ Query $ Sensing EntitySensing) "Get the x, y coordinates of the southwest corner of all constructed structures of a given name" $+      ["Since structures can have multiple occurrences, returns a list of (x, y) coordinates."]   Floorplan ->     command 1 Intangible . doc (Set.singleton $ Query APriori) "Get the dimensions of a structure template" $       [ "Returns a tuple of (width, height) for the structure of the requested name."       , "Yields an error if the supplied string is not the name of a structure."       ]   HasTag ->-    command 2 Intangible . doc (Set.singleton $ Query APriori) "Check whether the given entity has the given tag" $+    function 2 . doc (Set.singleton $ Query APriori) "Check whether the given entity has the given tag" $       [ "Returns true if the first argument is an entity that is labeled by the tag in the second argument."       , "Yields an error if the first argument is not a valid entity."       ]   TagMembers ->-    command 2 Intangible . doc (Set.singleton $ Query APriori) "Get the entities labeled by a tag." $-      [ "Returns a tuple of (member count, entity)."-      , "The supplied index will be wrapped automatically, modulo the member count."-      , "A robot can use the count to know whether they have iterated over the full list."-      , "Item order is determined by definition sequence in the scenario file."+    function 1 . doc (Set.singleton $ Query APriori) "Get the entities labeled by a tag." $+      [ "Returns a list of all entities with the given tag."+      , "The order of the list is determined by the definition sequence in the scenario file."       ]   Detect ->     command 2 Intangible . doc (Set.singleton $ Query $ Sensing EntitySensing) "Detect an entity within a rectangle." $@@ -769,7 +781,7 @@     command 1 Intangible . doc (Set.singleton $ Query PRNG) "Get a uniformly random integer." $       ["The random integer will be chosen from the range 0 to n-1, exclusive of the argument."]   Run -> command 1 long $ shortDoc (Set.singleton $ Mutation $ RobotChange BehaviorChange) "Run a program loaded from a file."-  Return -> command 1 Intangible $ shortDoc Set.empty "Make the value a result in `cmd`."+  Pure -> command 1 Intangible $ shortDoc Set.empty "Create a pure `Cmd a`{=type} computation that yields the given value."   Try -> command 2 Intangible $ shortDoc Set.empty "Execute a command, catching errors."   Undefined -> function 0 $ shortDoc Set.empty "A value of any type, that is evaluated as error."   Fail -> function 1 $ shortDoc Set.empty "A value of any type, that is evaluated as error with message."@@ -779,8 +791,7 @@   Inl -> function 1 $ shortDoc Set.empty "Put the value into the left component of a sum type."   Inr -> function 1 $ shortDoc Set.empty "Put the value into the right component of a sum type."   Case -> function 3 $ shortDoc Set.empty "Evaluate one of the given functions on a value of sum type."-  Fst -> function 1 $ shortDoc Set.empty "Get the first value of a pair."-  Snd -> function 1 $ shortDoc Set.empty "Get the second value of a pair."+  Match -> function 2 $ shortDoc Set.empty "Do something with both components of a pair."   Force -> function 1 $ shortDoc Set.empty "Force the evaluation of a delayed value."   Not -> function 1 $ shortDoc Set.empty "Negate the boolean value."   Neg -> unaryOp "-" 7 P $ shortDoc Set.empty "Negate the given integer value."@@ -798,6 +809,26 @@   Leq -> binaryOp "<=" 4 N $ shortDoc Set.empty "Check that the left value is lesser or equal to the right one."   Geq -> binaryOp ">=" 4 N $ shortDoc Set.empty "Check that the left value is greater or equal to the right one."   Format -> function 1 $ shortDoc Set.empty "Turn an arbitrary value into a string."+  Read -> function 2 $ shortDoc Set.empty "Try to read a string into a value of the expected type."+  Print ->+    command 2 short+      . doc+        (Set.singleton $ Mutation $ RobotChange InventoryChange)+        "Print text onto an entity."+      $ [ "`print p txt` Consumes one printable `p` entity from your inventory, and produces an entity"+        , "whose name is concatenated with a colon and the given text."+        , "In conjunction with `format`, this can be used to print values onto entities such as `paper`{=entity}"+        , "and give them to other robots, which can reconstitute the values with `read`."+        ]+  Erase ->+    command 1 short+      . doc+        (Set.singleton $ Mutation $ RobotChange InventoryChange)+        "Erase an entity."+      $ [ "Consumes the named printable entity from your inventory, which must have something"+        , "printed on it, and produces an erased entity.  This can be used to undo"+        , "the effects of a `print` command."+        ]   Concat -> binaryOp "++" 6 R $ shortDoc Set.empty "Concatenate the given strings."   Chars -> function 1 $ shortDoc Set.empty "Counts the number of characters in the text."   Split ->@@ -818,7 +849,7 @@   AppF ->     binaryOp "$" 0 R . doc Set.empty "Apply the function on the left to the value on the right." $       [ "This operator is useful to avoid nesting parentheses."-      , "For exaple:"+      , "For example:"       , "`f $ g $ h x = f (g (h x))`"       ]   Swap ->@@ -846,6 +877,7 @@       , "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."@@ -887,7 +919,7 @@       }    lowShow :: Show a => a -> Text-  lowShow = toLower . showT+  lowShow = T.toLower . showT  -- | Maximum perception distance for -- 'Chirp' and 'Sniff' commands
src/swarm-lang/Swarm/Language/Syntax/Loc.hs view
@@ -8,14 +8,17 @@ -- Types for working with locations of something in source code. module Swarm.Language.Syntax.Loc (   SrcLoc (..),-  LocVar (..),-  srcLocBefore,+  Located (..),+  LocVar,+  srcLocStartsBefore,+  srcLocEndsBefore, ) where  import Data.Aeson (FromJSON (..), ToJSON (..), genericParseJSON, genericToJSON) import Data.Data (Data)+import Data.Hashable (Hashable) import GHC.Generics (Generic)-import Swarm.Language.Context (Var)+import Swarm.Language.Var (Var) import Swarm.Util.JSON (optionsUntagged)  ------------------------------------------------------------@@ -28,13 +31,15 @@   = NoLoc   | -- | Half-open interval from start (inclusive) to end (exclusive)     SrcLoc Int Int-  deriving (Eq, Ord, Show, Data, Generic)+  deriving (Eq, Ord, Show, Data, Generic, Hashable)  instance ToJSON SrcLoc where   toJSON = genericToJSON optionsUntagged+  omitField = (== NoLoc)  instance FromJSON SrcLoc where   parseJSON = genericParseJSON optionsUntagged+  omittedField = Just NoLoc  -- | @x <> y@ is the smallest 'SrcLoc' that subsumes both @x@ and @y@. instance Semigroup SrcLoc where@@ -47,15 +52,24 @@ instance Monoid SrcLoc where   mempty = NoLoc --- | Check whether one @SrcLoc@ starts at or before another one,+-- | Check whether one @SrcLoc@ starts before another one, --   /i.e./ compare their starting indices to see if the first is @<=@ --   the second.-srcLocBefore :: SrcLoc -> SrcLoc -> Bool-srcLocBefore (SrcLoc a _) (SrcLoc b _) = a <= b-srcLocBefore _ _ = False+srcLocStartsBefore :: SrcLoc -> SrcLoc -> Bool+srcLocStartsBefore (SrcLoc a _) (SrcLoc b _) = a <= b+srcLocStartsBefore _ _ = False +-- | Check whether the first @SrcLoc@ ends before the second, /i.e./+--   compare their ending indices to see if the first is @<=@ the+--   second.+srcLocEndsBefore :: SrcLoc -> SrcLoc -> Bool+srcLocEndsBefore (SrcLoc _ a) (SrcLoc _ b) = a <= b+srcLocEndsBefore _ _ = False+ -- | A variable with associated source location, used for variable --   binding sites. (Variable occurrences are a bare TVar which gets --   wrapped in a Syntax node, so we don't need LocVar for those.)-data LocVar = LV {lvSrcLoc :: SrcLoc, lvVar :: Var}-  deriving (Eq, Ord, Show, Data, Generic, FromJSON, ToJSON)+data Located v = LV {lvSrcLoc :: SrcLoc, lvVar :: v}+  deriving (Eq, Ord, Functor, Show, Data, Generic, Hashable, FromJSON, ToJSON)++type LocVar = Located Var
src/swarm-lang/Swarm/Language/Syntax/Pattern.hs view
@@ -30,6 +30,7 @@   pattern TProj,   pattern TAnnotate,   pattern TSuspend,+  pattern TParens,   Term,   TTerm,   UTerm,@@ -38,11 +39,12 @@  import Control.Lens (makeLenses, pattern Empty) import Data.Map.Strict (Map)-import Data.Text hiding (filter, length, map)+import Data.Text (Text) import Swarm.Language.Requirements.Type (Requirements) import Swarm.Language.Syntax.AST import Swarm.Language.Syntax.Comments import Swarm.Language.Syntax.Loc+import Swarm.Language.TDVar import Swarm.Language.Types  -- | Syntax without type annotations.@@ -58,7 +60,9 @@  -- | Raw parsed syntax, without comments or type annotations. pattern Syntax :: SrcLoc -> Term -> Syntax-pattern Syntax l t = Syntax' l t Empty ()+pattern Syntax l t <- Syntax' l t _ ()+  where+    Syntax l t = Syntax' l t Empty ()  {-# COMPLETE Syntax #-} @@ -104,13 +108,13 @@ pattern (:$:) t1 s2 = SApp (STerm t1) s2  -- | Match a TLet without annotations.-pattern TLet :: LetSyntax -> Bool -> Var -> Maybe Polytype -> Maybe Requirements -> Term -> Term -> Term-pattern TLet ls r v mty mreq t1 t2 <- SLet ls r (lvVar -> v) mty mreq (STerm t1) (STerm t2)+pattern TLet :: LetSyntax -> Bool -> Var -> Maybe RawPolytype -> Maybe Polytype -> Maybe Requirements -> Term -> Term -> Term+pattern TLet ls r v mty mpty mreq t1 t2 <- SLet ls r (lvVar -> v) mty mpty mreq (STerm t1) (STerm t2)   where-    TLet ls r v mty mreq t1 t2 = SLet ls r (LV NoLoc v) mty mreq (STerm t1) (STerm t2)+    TLet ls r v mty mpty mreq t1 t2 = SLet ls r (LV NoLoc v) mty mpty mreq (STerm t1) (STerm t2)  -- | Match a STydef without annotations.-pattern TTydef :: Var -> Polytype -> Maybe TydefInfo -> Term -> Term+pattern TTydef :: TDVar -> Polytype -> Maybe TydefInfo -> Term -> Term pattern TTydef v ty mtd t1 <- STydef (lvVar -> v) ty mtd (STerm t1)   where     TTydef v ty mtd t1 = STydef (LV NoLoc v) ty mtd (STerm t1)@@ -135,13 +139,17 @@ pattern TProj t x = SProj (STerm t) x  -- | Match a TAnnotate without annotations.-pattern TAnnotate :: Term -> Polytype -> Term+pattern TAnnotate :: Term -> RawPolytype -> Term pattern TAnnotate t pt = SAnnotate (STerm t) pt  -- | Match a TSuspend without annotations. pattern TSuspend :: Term -> Term pattern TSuspend t = SSuspend (STerm t) +-- | Match a TParens without annotations.+pattern TParens :: Term -> Term+pattern TParens t = SParens (STerm t)+ -- COMPLETE pragma tells GHC using this set of patterns is complete for Term -{-# COMPLETE TUnit, TConst, TDir, TInt, TAntiInt, TText, TAntiText, TBool, TRequireDevice, TRequire, TRequirements, TVar, TPair, TLam, TApp, TLet, TTydef, TBind, TDelay, TRcd, TProj, TAnnotate, TSuspend #-}+{-# COMPLETE TUnit, TConst, TDir, TInt, TAntiInt, TText, TAntiText, TBool, TRequire, TStock, TRequirements, TVar, TPair, TLam, TApp, TLet, TTydef, TBind, TDelay, TRcd, TProj, TAnnotate, TSuspend, TParens #-}
+ src/swarm-lang/Swarm/Language/Syntax/Pretty.hs view
@@ -0,0 +1,188 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE ViewPatterns #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++-- We could avoid orphan instances by placing these PrettyPrec+-- instances in Swarm.Language.Syntax.AST, along with the declarations+-- of the types we are making PrettyPrec instances for, but the code+-- here depends nontrivially on stuff in other Swarm.Language.Syntax.*+-- modules, so that would require putting a whole bunch of stuff all+-- in the same module.  It seemed like a much better option to have+-- code split out into separate modules and disable orphan instance+-- warnings in this one.++-- |+-- SPDX-License-Identifier: BSD-3-Clause+--+-- Pretty-printing for terms in the Swarm programming language.+module Swarm.Language.Syntax.Pretty (++) where++import Control.Lens ((&), (<>~))+import Control.Lens.Empty (pattern Empty)+import Data.Bool (bool)+import Data.Foldable qualified as F+import Data.Map qualified as M+import Data.Sequence qualified as Seq+import Data.String (fromString)+import Prettyprinter+import Swarm.Language.Syntax.AST+import Swarm.Language.Syntax.Comments+import Swarm.Language.Syntax.Constants+import Swarm.Language.Syntax.Loc+import Swarm.Language.Syntax.Pattern (sComments, pattern STerm)+import Swarm.Language.Syntax.Util (erase, unTuple)+import Swarm.Language.TDVar (TDVar)+import Swarm.Language.Types+import Swarm.Pretty (PrettyPrec (..), encloseWithIndent, pparens, ppr, prettyEquality)+import Text.Show.Unicode (ushow)++-- | Pretty-print a syntax node with comments.+instance PrettyPrec (Syntax' ty) where+  prettyPrec p (Syntax' _ t (Comments before after) _) = case before of+    Empty -> t'+    _ ->+      -- Print out any comments before the node+      mconcat+        [ vsep (map ppr (F.toList before))+        , hardline+        , t'+        ]+   where+    -- Print the node itself, possibly with suffix comments on the same line+    t' = case Seq.viewr after of+      Seq.EmptyR -> prettyPrec p t+      _ Seq.:> lst -> case commentType lst of+        -- Output a newline after a line comment, but not after a block comment+        BlockComment -> tWithComments+        LineComment -> tWithComments <> hardline+     where+      -- The pretty-printed node with suffix comments+      tWithComments = prettyPrec p t <+> hsep (map ppr (F.toList after))++instance PrettyPrec (Term' ty) where+  prettyPrec p = \case+    TUnit -> "()"+    TConst c -> prettyPrec p c+    TDir d -> ppr d+    TInt n -> pretty n+    TAntiInt v -> "$int:" <> pretty v+    TText s -> fromString (ushow s)+    TAntiText v -> "$str:" <> pretty v+    TAntiSyn v -> "$syn:" <> pretty v+    TBool b -> bool "false" "true" b+    TRobot r -> "<a" <> pretty r <> ">"+    TRef r -> "@" <> pretty r+    TRequire d -> pparens (p > 10) $ "require" <+> ppr (TText d)+    TStock n e -> pparens (p > 10) $ "stock" <+> pretty n <+> ppr (TText e)+    SRequirements _ e -> pparens (p > 10) $ "requirements" <+> ppr e+    TVar s -> ppr s+    SDelay (Syntax' _ (TConst Noop) _ _) -> "{}"+    SDelay t -> group . encloseWithIndent 2 lbrace rbrace $ ppr t+    t@SPair {} -> prettyTuple t+    t@SLam {} ->+      pparens (p > 9) $+        prettyLambdas t+    -- Special handling of infix operators - ((+) 2) 3 --> 2 + 3.+    -- Note a comment right after the operator will end up attached to+    -- the application of the operator to the first argument.+    SApp t@(Syntax' _ (SApp op@(Syntax' _ (TConst c) _ _) l) opcom _) r ->+      let ci = constInfo c+          pC = fixity ci+       in case constMeta ci of+            ConstMBinOp assoc ->+              pparens (p > pC) $+                hsep+                  [ prettyPrec (pC + fromEnum (assoc == R)) l+                  , -- pretty-print the operator with comments reattached+                    ppr (op {_sComments = opcom})+                  , prettyPrec (pC + fromEnum (assoc == L)) r+                  ]+            _ -> prettyPrecApp p t r+    SApp t1 t2 -> case t1 of+      Syntax' _ (TConst c) _ _ ->+        let ci = constInfo c+            pC = fixity ci+         in case constMeta ci of+              ConstMUnOp P -> pparens (p > pC) $ ppr t1 <> prettyPrec (succ pC) t2+              ConstMUnOp S -> pparens (p > pC) $ prettyPrec (succ pC) t2 <> ppr t1+              _ -> prettyPrecApp p t1 t2+      _ -> prettyPrecApp p t1 t2+    SLet LSLet _ (LV _ x) mty _ _ t1 t2 ->+      sep+        [ prettyDefinition "let" x mty t1 <+> "in"+        , ppr t2+        ]+    SLet LSDef _ (LV _ x) mty _ _ t1 t2 ->+      mconcat $+        sep [prettyDefinition "def" x mty t1, "end"]+          : case t2 of+            Syntax' _ (TConst Noop) _ _ -> []+            _ -> [hardline, hardline, ppr t2]+    STydef (LV _ x) pty _ t1 ->+      mconcat $+        prettyTydef x pty+          : case t1 of+            Syntax' _ (TConst Noop) _ _ -> []+            _ -> [hardline, hardline, ppr t1]+    SBind Nothing _ _ _ t1 t2 ->+      pparens (p > 0) $+        prettyPrec 1 t1 <> ";" <> line <> prettyPrec 0 t2+    SBind (Just (LV _ x)) _ _ _ t1 t2 ->+      pparens (p > 0) $+        ppr x <+> "<-" <+> prettyPrec 1 t1 <> ";" <> line <> prettyPrec 0 t2+    SRcd m -> brackets $ hsep (punctuate "," (map prettyEquality (M.assocs m)))+    SProj t x -> prettyPrec 11 t <> "." <> ppr x+    SAnnotate t pt ->+      pparens (p > 0) $+        prettyPrec 1 t <+> ":" <+> ppr pt+    SSuspend t ->+      pparens (p > 10) $+        "suspend" <+> prettyPrec 11 t+    SParens t -> pparens True (ppr t)+    TType ty -> "@" <> prettyPrec 11 ty++prettyDefinition :: Doc ann -> Var -> Maybe (Poly q Type) -> Syntax' ty -> Doc ann+prettyDefinition defName x mty t1 =+  nest 2 . sep $+    [ flatAlt+        (defHead <> group defType <+> eqAndLambdaLine)+        (defHead <> group defType' <+> defEqLambdas)+    , ppr defBody+    ]+ where+  (defBody, defLambdaList) = unchainLambdas t1+  defHead = defName <+> ppr x+  defType = maybe "" (\ty -> ":" <+> flatAlt (line <> indent 2 (ppr ty)) (ppr ty)) mty+  defType' = maybe "" (\ty -> ":" <+> ppr ty) mty+  defEqLambdas = hsep ("=" : map prettyLambda defLambdaList)+  eqAndLambdaLine = if null defLambdaList then "=" else line <> defEqLambdas++prettyTydef :: TDVar -> Polytype -> Doc ann+prettyTydef x (unPoly -> ([], ty)) = "tydef" <+> ppr x <+> "=" <+> ppr ty <+> "end"+prettyTydef x (unPoly -> (xs, ty)) = "tydef" <+> ppr x <+> hsep (map ppr xs) <+> "=" <+> ppr ty <+> "end"++prettyPrecApp :: Int -> Syntax' ty -> Syntax' ty -> Doc a+prettyPrecApp p t1 t2 =+  pparens (p > 10) $+    prettyPrec 10 t1 <+> prettyPrec 11 t2++prettyTuple :: Term' ty -> Doc a+prettyTuple = tupled . map ppr . unTuple . STerm . erase++prettyLambdas :: Term' ty -> Doc a+prettyLambdas t = hsep (prettyLambda <$> lms) <> softline <> ppr rest+ where+  (rest, lms) = unchainLambdas (STerm (erase t))++unchainLambdas :: Syntax' ty -> (Syntax' ty, [(Var, Maybe Type)])+unchainLambdas = \case+  -- Peel off consecutive lambdas, being sure to accumulate any+  -- attached comments along the way so they attach to the body+  Syntax' _ (SLam (LV _ x) mty body) coms _ -> ((x, mty) :) <$> unchainLambdas (body & sComments <>~ coms)+  body -> (body, [])++prettyLambda :: (PrettyPrec a1, PrettyPrec a2) => (a1, Maybe a2) -> Doc ann+prettyLambda (x, mty) = "\\" <> ppr x <> maybe "" ((":" <>) . ppr) mty <> "."
src/swarm-lang/Swarm/Language/Syntax/Util.hs view

file too large to diff

+ src/swarm-lang/Swarm/Language/TDVar.hs view

file too large to diff

src/swarm-lang/Swarm/Language/Text/Markdown.hs view

file too large to diff

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

file too large to diff

src/swarm-lang/Swarm/Language/Types.hs view

file too large to diff

src/swarm-lang/Swarm/Language/Value.hs view

file too large to diff

+ src/swarm-lang/Swarm/Language/Var.hs view

file too large to diff

src/swarm-scenario/Swarm/Game/Achievement/Definitions.hs view

file too large to diff

src/swarm-scenario/Swarm/Game/Device.hs view

file too large to diff

src/swarm-scenario/Swarm/Game/Display.hs view

file too large to diff

src/swarm-scenario/Swarm/Game/Entity.hs view

file too large to diff

src/swarm-scenario/Swarm/Game/Entity/Cosmetic.hs view

file too large to diff

src/swarm-scenario/Swarm/Game/Entity/Cosmetic/Assignment.hs view

file too large to diff

− src/swarm-scenario/Swarm/Game/Failure.hs

file too large to diff

src/swarm-scenario/Swarm/Game/Land.hs view

file too large to diff

src/swarm-scenario/Swarm/Game/Recipe.hs view

file too large to diff

+ src/swarm-scenario/Swarm/Game/Recipe/Graph.hs view

file too large to diff

− src/swarm-scenario/Swarm/Game/ResourceLoading.hs

file too large to diff

src/swarm-scenario/Swarm/Game/Robot.hs view

file too large to diff

src/swarm-scenario/Swarm/Game/Scenario.hs view

file too large to diff

src/swarm-scenario/Swarm/Game/Scenario/Objective/Graph.hs view

file too large to diff

src/swarm-scenario/Swarm/Game/Scenario/Objective/Validation.hs view

file too large to diff

src/swarm-scenario/Swarm/Game/Scenario/Style.hs view

file too large to diff

src/swarm-scenario/Swarm/Game/Scenario/Topography/Cell.hs view

file too large to diff

src/swarm-scenario/Swarm/Game/Scenario/Topography/Navigation/Portal.hs view

file too large to diff

− src/swarm-scenario/Swarm/Game/Scenario/Topography/Structure/Recognition/Precompute.hs

file too large to diff

src/swarm-scenario/Swarm/Game/Scenario/Topography/WorldDescription.hs view

file too large to diff

src/swarm-scenario/Swarm/Game/Scenario/Topography/WorldPalette.hs view

file too large to diff

src/swarm-scenario/Swarm/Game/State/Config.hs view

file too large to diff

src/swarm-scenario/Swarm/Game/State/Landscape.hs view

file too large to diff

src/swarm-scenario/Swarm/Game/Terrain.hs view

file too large to diff

src/swarm-scenario/Swarm/Game/World.hs view

file too large to diff

src/swarm-scenario/Swarm/Game/World/Gen.hs view

file too large to diff

src/swarm-scenario/Swarm/Game/World/Interpret.hs view

file too large to diff

src/swarm-scenario/Swarm/Game/World/Load.hs view

file too large to diff

− src/swarm-scenario/Swarm/Game/World/Modify.hs

file too large to diff

src/swarm-scenario/Swarm/Game/World/Parse.hs view

file too large to diff

src/swarm-scenario/Swarm/Game/World/Render.hs view

file too large to diff

src/swarm-scenario/Swarm/Game/World/Syntax.hs view

file too large to diff

src/swarm-scenario/Swarm/Game/World/Typecheck.hs view

file too large to diff

src/swarm-topography/Swarm/Game/Location.hs view

file too large to diff

src/swarm-topography/Swarm/Game/Scenario/Topography/Area.hs view

file too large to diff

src/swarm-topography/Swarm/Game/Scenario/Topography/Grid.hs view

file too large to diff

+ src/swarm-topography/Swarm/Game/Scenario/Topography/Modify.hs view

file too large to diff

src/swarm-topography/Swarm/Game/Scenario/Topography/Navigation/Waypoint.hs view

file too large to diff

src/swarm-topography/Swarm/Game/Scenario/Topography/Placement.hs view

file too large to diff

src/swarm-topography/Swarm/Game/Scenario/Topography/ProtoCell.hs view

file too large to diff

src/swarm-topography/Swarm/Game/Scenario/Topography/Rasterize.hs view

file too large to diff

src/swarm-topography/Swarm/Game/Scenario/Topography/Structure.hs view

file too large to diff

src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Assembly.hs view

file too large to diff

+ src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Named.hs view

file too large to diff

src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Overlay.hs view

file too large to diff

src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Recognition.hs view

file too large to diff

src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Recognition/Log.hs view

file too large to diff

+ src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Recognition/Precompute.hs view

file too large to diff

src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Recognition/Prep.hs view

file too large to diff

src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Recognition/Registry.hs view

file too large to diff

+ src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Recognition/Static.hs view

file too large to diff

src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Recognition/Symmetry.hs view

file too large to diff

+ src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Recognition/Tracking.hs view

file too large to diff

src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Recognition/Type.hs view

file too large to diff

+ src/swarm-topography/Swarm/Game/Scenario/Topography/Terraform.hs view

file too large to diff

src/swarm-topography/Swarm/Game/Universe.hs view

file too large to diff

src/swarm-tournament/Swarm/Web/Tournament.hs view

file too large to diff

src/swarm-tournament/Swarm/Web/Tournament/Validate.hs view

file too large to diff

src/swarm-tournament/Swarm/Web/Tournament/Validate/FailureMode.hs view

file too large to diff

src/swarm-tui/Swarm/TUI/Controller.hs view

file too large to diff

src/swarm-tui/Swarm/TUI/Controller/EventHandlers.hs view

file too large to diff

src/swarm-tui/Swarm/TUI/Controller/EventHandlers/Frame.hs view

file too large to diff

src/swarm-tui/Swarm/TUI/Controller/EventHandlers/Main.hs view

file too large to diff

src/swarm-tui/Swarm/TUI/Controller/EventHandlers/REPL.hs view

file too large to diff

src/swarm-tui/Swarm/TUI/Controller/EventHandlers/Robot.hs view

file too large to diff

src/swarm-tui/Swarm/TUI/Controller/EventHandlers/World.hs view

file too large to diff

src/swarm-tui/Swarm/TUI/Controller/SaveScenario.hs view

file too large to diff

src/swarm-tui/Swarm/TUI/Controller/UpdateUI.hs view

file too large to diff

src/swarm-tui/Swarm/TUI/Controller/Util.hs view

file too large to diff

src/swarm-tui/Swarm/TUI/Editor/Controller.hs view

file too large to diff

src/swarm-tui/Swarm/TUI/Editor/Masking.hs view

file too large to diff

src/swarm-tui/Swarm/TUI/Editor/Model.hs view

file too large to diff

src/swarm-tui/Swarm/TUI/Editor/Palette.hs view

file too large to diff

src/swarm-tui/Swarm/TUI/Editor/Util.hs view

file too large to diff

src/swarm-tui/Swarm/TUI/Editor/View.hs view

file too large to diff

src/swarm-tui/Swarm/TUI/Launch/Controller.hs view

file too large to diff

src/swarm-tui/Swarm/TUI/Launch/Model.hs view

file too large to diff

src/swarm-tui/Swarm/TUI/Launch/Prep.hs view

file too large to diff

src/swarm-tui/Swarm/TUI/Launch/View.hs view

file too large to diff

src/swarm-tui/Swarm/TUI/Model.hs view

file too large to diff

src/swarm-tui/Swarm/TUI/Model/Achievements.hs view

file too large to diff

+ src/swarm-tui/Swarm/TUI/Model/DebugOption.hs view

file too large to diff

+ src/swarm-tui/Swarm/TUI/Model/Dialog.hs view

file too large to diff

+ src/swarm-tui/Swarm/TUI/Model/Dialog/Goal.hs view

file too large to diff

+ src/swarm-tui/Swarm/TUI/Model/Dialog/Structure.hs view

file too large to diff

src/swarm-tui/Swarm/TUI/Model/Event.hs view

file too large to diff

− src/swarm-tui/Swarm/TUI/Model/Goal.hs

file too large to diff

src/swarm-tui/Swarm/TUI/Model/KeyBindings.hs view

file too large to diff

src/swarm-tui/Swarm/TUI/Model/Menu.hs view

file too large to diff

src/swarm-tui/Swarm/TUI/Model/Name.hs view

file too large to diff

− src/swarm-tui/Swarm/TUI/Model/Popup.hs

file too large to diff

src/swarm-tui/Swarm/TUI/Model/Repl.hs view

file too large to diff

src/swarm-tui/Swarm/TUI/Model/StateUpdate.hs view

file too large to diff

− src/swarm-tui/Swarm/TUI/Model/Structure.hs

file too large to diff

src/swarm-tui/Swarm/TUI/Model/UI.hs view

file too large to diff

+ src/swarm-tui/Swarm/TUI/Model/UI/Gameplay.hs view

file too large to diff

+ src/swarm-tui/Swarm/TUI/Model/WebCommand.hs view

file too large to diff

src/swarm-tui/Swarm/TUI/Panel.hs view

file too large to diff

src/swarm-tui/Swarm/TUI/View.hs view

file too large to diff

src/swarm-tui/Swarm/TUI/View/Achievement.hs view

file too large to diff

src/swarm-tui/Swarm/TUI/View/Attribute/Attr.hs view

file too large to diff

src/swarm-tui/Swarm/TUI/View/Attribute/CustomStyling.hs view

file too large to diff

src/swarm-tui/Swarm/TUI/View/CellDisplay.hs view

file too large to diff

src/swarm-tui/Swarm/TUI/View/Objective.hs view

file too large to diff

src/swarm-tui/Swarm/TUI/View/Popup.hs view

file too large to diff

+ src/swarm-tui/Swarm/TUI/View/Robot.hs view

file too large to diff

+ src/swarm-tui/Swarm/TUI/View/Robot/Details.hs view

file too large to diff

+ src/swarm-tui/Swarm/TUI/View/Robot/Type.hs view

file too large to diff

+ src/swarm-tui/Swarm/TUI/View/Shared.hs view

file too large to diff

src/swarm-tui/Swarm/TUI/View/Structure.hs view

file too large to diff

src/swarm-tui/Swarm/TUI/View/Util.hs view

file too large to diff

− src/swarm-util/Control/Carrier/Accum/FixedStrict.hs

file too large to diff

src/swarm-util/Data/BoolExpr/Simplify.hs view

file too large to diff

+ src/swarm-util/Swarm/Failure.hs view

file too large to diff

src/swarm-util/Swarm/Language/Syntax/Direction.hs view

file too large to diff

+ src/swarm-util/Swarm/Pretty.hs view

file too large to diff

+ src/swarm-util/Swarm/ResourceLoading.hs view

file too large to diff

src/swarm-util/Swarm/Util.hs view

file too large to diff

src/swarm-util/Swarm/Util/Effect.hs view

file too large to diff

+ src/swarm-util/Swarm/Util/Graph.hs view

file too large to diff

− src/swarm-util/Swarm/Util/ReadableIORef.hs

file too large to diff

src/swarm-util/Swarm/Util/WindowedCounter.hs view

file too large to diff

src/swarm-web/Swarm/Web.hs view

file too large to diff

+ src/swarm-web/Swarm/Web/GraphRender.hs view

file too large to diff

src/swarm-web/Swarm/Web/Worldview.hs view

file too large to diff

swarm.cabal view

file too large to diff

test/bench/Benchmark.hs view

file too large to diff

test/integration/Main.hs view

file too large to diff

+ test/integration/TestFormat.hs view

file too large to diff

test/integration/TestRecipeCoverage.hs view

file too large to diff

test/standalone-topography/src/Lib.hs view

file too large to diff

test/standalone-topography/src/Main.hs view

file too large to diff

test/unit/Main.hs view

file too large to diff

+ test/unit/TestContext.hs view

file too large to diff

test/unit/TestEval.hs view

file too large to diff

test/unit/TestLSP.hs view

file too large to diff

test/unit/TestLanguagePipeline.hs view

file too large to diff

test/unit/TestOverlay.hs view

file too large to diff

test/unit/TestPedagogy.hs view

file too large to diff

test/unit/TestPretty.hs view

file too large to diff

+ test/unit/TestQQ.hs view

file too large to diff

test/unit/TestRepl.hs view

file too large to diff

test/unit/TestRequirements.hs view

file too large to diff