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))
|
|
|
|
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)
|
2021-10-06 22:15:32 +03:00
|
|
|
import Swarm.Game.Robot (Robot, mkRobot)
|
2022-01-28 02:00:00 +03:00
|
|
|
import Swarm.Game.State (GameState, GameType (ClassicGame), addRobot, creativeMode, initGameState, 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)
|
2021-10-01 14:59:34 +03:00
|
|
|
import qualified Swarm.Language.Context as Context
|
|
|
|
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;
|
|
|
|
turn east;
|
|
|
|
move;
|
|
|
|
turn south;
|
|
|
|
move;
|
|
|
|
turn west;
|
|
|
|
move;
|
|
|
|
turn north
|
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.
|
|
|
|
initRobot :: ProcessedTerm -> V2 Int64 -> Robot
|
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
|
|
|
initRobot prog loc = mkRobot "" north loc (initMachine prog Context.empty emptyStore) []
|
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.
|
|
|
|
mkGameState :: (V2 Int64 -> Robot) -> Int -> IO GameState
|
|
|
|
mkGameState robotMaker numRobots = do
|
|
|
|
let robots = [robotMaker (V2 (fromIntegral x) 0) | x <- [0 .. numRobots -1]]
|
2022-01-28 02:00:00 +03:00
|
|
|
Right initState <- runExceptT (initGameState (ClassicGame 0))
|
2021-10-06 22:15:32 +03:00
|
|
|
execStateT
|
|
|
|
(mapM addRobot robots)
|
|
|
|
( 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
|
|
|
|
]
|