2021-10-01 14:59:34 +03:00
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
{-# LANGUAGE QuasiQuotes #-}
|
|
|
|
|
|
|
|
module Main where
|
|
|
|
|
|
|
|
import Control.Lens ((&), (.~))
|
2021-10-06 22:15:32 +03:00
|
|
|
import Control.Monad (replicateM_)
|
2021-10-01 14:59:34 +03:00
|
|
|
import Control.Monad.Except (runExceptT)
|
|
|
|
import Control.Monad.State (evalStateT, execStateT)
|
2021-10-06 22:15:32 +03:00
|
|
|
import Criterion.Main (Benchmark, bench, bgroup, defaultConfig, defaultMainWith, whnfAppIO)
|
|
|
|
import Criterion.Types (Config (timeLimit))
|
2022-07-01 12:07:41 +03:00
|
|
|
import Data.Functor.Const qualified as F
|
2021-10-06 22:15:32 +03:00
|
|
|
import Data.Int (Int64)
|
2021-10-01 14:59:34 +03:00
|
|
|
import Linear.V2 (V2 (V2))
|
Delay type (#223)
Make explicit in the type system when evaluation of a computation should be delayed. This gives the user fine-grained control over selective laziness (for example, once we have sum types and recursive types, one could use this to define lazy infinite data structures). It also allows us to guarantee that certain commands such as `build` and `reprogram` delay evaluation of their arguments, and lets the user e.g. define their own modified versions of `build` without compromising those guarantees.
- Delay is indicated by curly braces both at the value and type levels, that is, if `t : ty` then `{t} : {ty}`.
- `force : {ty} -> ty` is now exposed in the surface language.
- Change from a CEK machine to a CESK machine. Recursive `let` and `def` delay via allocating a cell in the store. For now, there is no other way to allocate anything in the store, but see discussion at #150 for some possible future directions.
- change the types of `build` and `reprogram` to require a delayed program, e.g. `build : string -> {cmd a} -> cmd string`
- `if` and `try` also require delayed arguments.
- don't elaborate Build and Reprogram with extra Delay wrappers since one is now required by the type
- Division by zero, negative exponents, and bad comparisons now throw exceptions.
Closes #150. Closes #226.
2021-10-25 16:28:41 +03:00
|
|
|
import Swarm.Game.CESK (emptyStore, initMachine)
|
Use a new opaque type for robots instead of strings (#303)
The basic idea of this change is to create a new `robot` type and use it to identify robots instead of `string` names. Internally, a `robot` value is just a (unique) `Int`.
Closes #212 .
This ended up turning into a sort of constellation of related changes.
- Add the `robot` type and change the type of various built-in functions which used to take a robot name so they now take a `robot` (`give`, `install`, `reprogram`, `view`, `upload`) and change `build` so it returns a `robot`.
- All internal data structures that store robots are now keyed by a unique (`Int`) robot ID rather than by name.
- Add a `setname` command for setting a robot's display name (which no longer needs to uniquely identify a robot).
- Import a big list of words which we can use to randomly pick names for robots, just for fun. This is why the diff says "+31,050 -265"; I did not write 31 thousand lines of code.
- Add constants `base`, `parent`, and `self` for getting a `robot` value referring to the base, one's parent, and one's self, respectively.
- Top-level binders like `r <- build {move}` now export a variable binding which can be used in later expressions entered at the REPL; additionally, unlike Haskell, a binder can now appear as the last statement in a block.
- Fix the pretty-printer for `Value` by doubling down on our current strategy of injecting `Value`s back into `Term`s and then pretty-printing the result. I am now convinced this is the Right Way (tm) to do this; it only required adding a couple additional kinds of `Term` which represent internal results of evaluation and cannot show up in the surface language (`TRef`, `TRobot`).
- Update the tutorial.
- While updating the tutorial, I noticed that #294 had introduced a bug, where the inventory display no longer updated when 0 copies of an entity are added to the inventory (as with `scan` + `upload`), so I fixed that by changing the way inventory hashes are computed.
I tried running the benchmarks both before & after this change. I was hoping that it might speed things up to be using `IntMap` and `IntSet` instead of looking things up by `Text` keys in a `Map` all the time. However, if I'm interpreting the results correctly, it seems like it didn't really make all that much difference, at least for the particular benchmarks we have.
2022-03-02 06:00:44 +03:00
|
|
|
import Swarm.Game.Display (defaultRobotDisplay)
|
2022-03-07 01:06:51 +03:00
|
|
|
import Swarm.Game.Robot (URobot, mkRobot)
|
2022-06-09 01:32:12 +03:00
|
|
|
import Swarm.Game.State (GameState, addURobot, classicGame0, creativeMode, world)
|
2021-10-01 14:59:34 +03:00
|
|
|
import Swarm.Game.Step (gameTick)
|
2021-10-06 22:15:32 +03:00
|
|
|
import Swarm.Game.Terrain (TerrainType (DirtT))
|
|
|
|
import Swarm.Game.World (newWorld)
|
2022-07-01 12:07:41 +03:00
|
|
|
import Swarm.Language.Context qualified as Context
|
2021-10-01 14:59:34 +03:00
|
|
|
import Swarm.Language.Pipeline (ProcessedTerm)
|
|
|
|
import Swarm.Language.Pipeline.QQ (tmQ)
|
2021-10-06 22:15:32 +03:00
|
|
|
import Swarm.Language.Syntax (north)
|
2021-10-01 14:59:34 +03:00
|
|
|
|
2021-10-06 22:15:32 +03:00
|
|
|
-- | The program of a robot that does nothing.
|
|
|
|
idleProgram :: ProcessedTerm
|
|
|
|
idleProgram = [tmQ| {} |]
|
|
|
|
|
|
|
|
-- | The program of a robot which waits a random number of ticks, changes its
|
|
|
|
-- appearence, then waits another random number of ticks, places a tree, and
|
|
|
|
-- then self-destructs.
|
|
|
|
treeProgram :: ProcessedTerm
|
|
|
|
treeProgram =
|
2021-10-01 14:59:34 +03:00
|
|
|
[tmQ|
|
2021-10-05 23:54:12 +03:00
|
|
|
{
|
2021-10-06 22:15:32 +03:00
|
|
|
r <- random 100;
|
|
|
|
wait (r + 300);
|
2021-10-01 14:59:34 +03:00
|
|
|
appear "|";
|
2021-10-06 22:15:32 +03:00
|
|
|
r <- random 100;
|
|
|
|
wait (r + 300);
|
2021-10-01 14:59:34 +03:00
|
|
|
place "tree";
|
|
|
|
selfdestruct
|
|
|
|
}
|
|
|
|
|]
|
|
|
|
|
2021-10-06 22:15:32 +03:00
|
|
|
-- | The program of a robot that moves forward forever.
|
|
|
|
moverProgram :: ProcessedTerm
|
|
|
|
moverProgram =
|
|
|
|
[tmQ|
|
Delay type (#223)
Make explicit in the type system when evaluation of a computation should be delayed. This gives the user fine-grained control over selective laziness (for example, once we have sum types and recursive types, one could use this to define lazy infinite data structures). It also allows us to guarantee that certain commands such as `build` and `reprogram` delay evaluation of their arguments, and lets the user e.g. define their own modified versions of `build` without compromising those guarantees.
- Delay is indicated by curly braces both at the value and type levels, that is, if `t : ty` then `{t} : {ty}`.
- `force : {ty} -> ty` is now exposed in the surface language.
- Change from a CEK machine to a CESK machine. Recursive `let` and `def` delay via allocating a cell in the store. For now, there is no other way to allocate anything in the store, but see discussion at #150 for some possible future directions.
- change the types of `build` and `reprogram` to require a delayed program, e.g. `build : string -> {cmd a} -> cmd string`
- `if` and `try` also require delayed arguments.
- don't elaborate Build and Reprogram with extra Delay wrappers since one is now required by the type
- Division by zero, negative exponents, and bad comparisons now throw exceptions.
Closes #150. Closes #226.
2021-10-25 16:28:41 +03:00
|
|
|
let forever : cmd () -> cmd () = \c. c; forever c
|
2021-10-06 22:15:32 +03:00
|
|
|
in forever move
|
|
|
|
|]
|
2021-10-01 14:59:34 +03:00
|
|
|
|
2021-10-06 22:15:32 +03:00
|
|
|
-- | The program of a robot that moves in circles forever.
|
|
|
|
circlerProgram :: ProcessedTerm
|
|
|
|
circlerProgram =
|
|
|
|
[tmQ|
|
Delay type (#223)
Make explicit in the type system when evaluation of a computation should be delayed. This gives the user fine-grained control over selective laziness (for example, once we have sum types and recursive types, one could use this to define lazy infinite data structures). It also allows us to guarantee that certain commands such as `build` and `reprogram` delay evaluation of their arguments, and lets the user e.g. define their own modified versions of `build` without compromising those guarantees.
- Delay is indicated by curly braces both at the value and type levels, that is, if `t : ty` then `{t} : {ty}`.
- `force : {ty} -> ty` is now exposed in the surface language.
- Change from a CEK machine to a CESK machine. Recursive `let` and `def` delay via allocating a cell in the store. For now, there is no other way to allocate anything in the store, but see discussion at #150 for some possible future directions.
- change the types of `build` and `reprogram` to require a delayed program, e.g. `build : string -> {cmd a} -> cmd string`
- `if` and `try` also require delayed arguments.
- don't elaborate Build and Reprogram with extra Delay wrappers since one is now required by the type
- Division by zero, negative exponents, and bad comparisons now throw exceptions.
Closes #150. Closes #226.
2021-10-25 16:28:41 +03:00
|
|
|
let forever : cmd () -> cmd () = \c. c; forever c
|
|
|
|
in forever (
|
2021-10-06 22:15:32 +03:00
|
|
|
move;
|
2022-06-14 19:13:27 +03:00
|
|
|
turn right;
|
2021-10-06 22:15:32 +03:00
|
|
|
move;
|
2022-06-14 19:13:27 +03:00
|
|
|
turn right;
|
2021-10-06 22:15:32 +03:00
|
|
|
move;
|
2022-06-14 19:13:27 +03:00
|
|
|
turn right;
|
2021-10-06 22:15:32 +03:00
|
|
|
move;
|
2022-06-14 19:13:27 +03:00
|
|
|
turn right;
|
Delay type (#223)
Make explicit in the type system when evaluation of a computation should be delayed. This gives the user fine-grained control over selective laziness (for example, once we have sum types and recursive types, one could use this to define lazy infinite data structures). It also allows us to guarantee that certain commands such as `build` and `reprogram` delay evaluation of their arguments, and lets the user e.g. define their own modified versions of `build` without compromising those guarantees.
- Delay is indicated by curly braces both at the value and type levels, that is, if `t : ty` then `{t} : {ty}`.
- `force : {ty} -> ty` is now exposed in the surface language.
- Change from a CEK machine to a CESK machine. Recursive `let` and `def` delay via allocating a cell in the store. For now, there is no other way to allocate anything in the store, but see discussion at #150 for some possible future directions.
- change the types of `build` and `reprogram` to require a delayed program, e.g. `build : string -> {cmd a} -> cmd string`
- `if` and `try` also require delayed arguments.
- don't elaborate Build and Reprogram with extra Delay wrappers since one is now required by the type
- Division by zero, negative exponents, and bad comparisons now throw exceptions.
Closes #150. Closes #226.
2021-10-25 16:28:41 +03:00
|
|
|
)
|
2021-10-06 22:15:32 +03:00
|
|
|
|]
|
|
|
|
|
|
|
|
-- | Initializes a robot with program prog at location loc facing north.
|
2022-03-07 01:06:51 +03:00
|
|
|
initRobot :: ProcessedTerm -> V2 Int64 -> URobot
|
2022-06-25 15:38:51 +03:00
|
|
|
initRobot prog loc = mkRobot (F.Const ()) Nothing "" [] north loc defaultRobotDisplay (initMachine prog Context.empty emptyStore) [] [] False 0
|
2021-10-06 22:15:32 +03:00
|
|
|
|
|
|
|
-- | Creates a GameState with numRobot copies of robot on a blank map, aligned
|
|
|
|
-- in a row starting at (0,0) and spreading east.
|
2022-03-07 01:06:51 +03:00
|
|
|
mkGameState :: (V2 Int64 -> URobot) -> Int -> IO GameState
|
2021-10-06 22:15:32 +03:00
|
|
|
mkGameState robotMaker numRobots = do
|
2022-06-09 01:32:12 +03:00
|
|
|
let robots = [robotMaker (V2 (fromIntegral x) 0) | x <- [0 .. numRobots - 1]]
|
2022-06-04 16:20:49 +03:00
|
|
|
Right initState <- runExceptT classicGame0
|
2021-10-06 22:15:32 +03:00
|
|
|
execStateT
|
2022-03-07 01:06:51 +03:00
|
|
|
(mapM addURobot robots)
|
2021-10-06 22:15:32 +03:00
|
|
|
( initState
|
2022-01-28 02:00:00 +03:00
|
|
|
& creativeMode .~ True
|
2021-10-06 22:15:32 +03:00
|
|
|
& world .~ newWorld (const (fromEnum DirtT, Nothing))
|
|
|
|
)
|
2021-10-01 14:59:34 +03:00
|
|
|
|
|
|
|
-- | Runs numGameTicks ticks of the game.
|
|
|
|
runGame :: Int -> GameState -> IO ()
|
|
|
|
runGame numGameTicks = evalStateT (replicateM_ numGameTicks gameTick)
|
|
|
|
|
|
|
|
main :: IO ()
|
|
|
|
main = do
|
2021-10-06 22:15:32 +03:00
|
|
|
idlers <- mkGameStates idleProgram [10, 20 .. 40]
|
|
|
|
trees <- mkGameStates treeProgram [10, 20 .. 40]
|
|
|
|
circlers <- mkGameStates circlerProgram [10, 20 .. 40]
|
|
|
|
movers <- mkGameStates moverProgram [10, 20 .. 40]
|
2021-10-01 14:59:34 +03:00
|
|
|
-- In theory we should force the evaluation of these game states to normal
|
|
|
|
-- form before running the benchmarks. In practice, the first of the many
|
|
|
|
-- criterion runs for each of these benchmarks doesn't look like an outlier.
|
2021-10-06 22:15:32 +03:00
|
|
|
defaultMainWith
|
|
|
|
(defaultConfig {timeLimit = 10})
|
2021-10-01 14:59:34 +03:00
|
|
|
[ bgroup
|
|
|
|
"run 1000 game ticks"
|
2021-10-06 22:15:32 +03:00
|
|
|
[ bgroup "idlers" (toBenchmarks idlers)
|
|
|
|
, bgroup "trees" (toBenchmarks trees)
|
|
|
|
, bgroup "circlers" (toBenchmarks circlers)
|
|
|
|
, bgroup "movers" (toBenchmarks movers)
|
2021-10-01 14:59:34 +03:00
|
|
|
]
|
2021-10-05 22:43:52 +03:00
|
|
|
]
|
2021-10-06 22:15:32 +03:00
|
|
|
where
|
|
|
|
mkGameStates :: ProcessedTerm -> [Int] -> IO [(Int, GameState)]
|
|
|
|
mkGameStates prog sizes = zip sizes <$> mapM (mkGameState (initRobot prog)) sizes
|
|
|
|
|
|
|
|
toBenchmarks :: [(Int, GameState)] -> [Benchmark]
|
|
|
|
toBenchmarks gameStates =
|
|
|
|
[ bench (show n) $ whnfAppIO (runGame 1000) gameState
|
|
|
|
| (n, gameState) <- gameStates
|
|
|
|
]
|