diff --git a/scripts/reformat-code.sh b/scripts/reformat-code.sh index fd34cd291..e6ad9e905 100755 --- a/scripts/reformat-code.sh +++ b/scripts/reformat-code.sh @@ -3,4 +3,4 @@ SCRIPT_DIR=$( cd -- "$( dirname -- "${BASH_SOURCE[0]}" )" &> /dev/null && pwd ) cd $SCRIPT_DIR/.. -fourmolu --mode=inplace src app test bench \ No newline at end of file +fourmolu --mode=inplace src app test \ No newline at end of file diff --git a/swarm.cabal b/swarm.cabal index 5d02fd0f1..4ea992892 100644 --- a/swarm.cabal +++ b/swarm.cabal @@ -396,10 +396,9 @@ test-suite swarm-integration benchmark benchmark import: stan-config, common, ghc2021-extensions main-is: Benchmark.hs - hs-source-dirs: bench + hs-source-dirs: test/bench type: exitcode-stdio-1.0 - build-depends: criterion >= 1.6.0.0 && < 1.7, - -- Import shared with the library don't need bounds + build-depends: tasty-bench >= 0.3.1 && < 0.4, base, lens, linear, @@ -407,6 +406,6 @@ benchmark benchmark random, swarm, text, - containers + containers, default-language: Haskell2010 ghc-options: -threaded diff --git a/bench/Benchmark.hs b/test/bench/Benchmark.hs similarity index 68% rename from bench/Benchmark.hs rename to test/bench/Benchmark.hs index 7459eebd4..0e1613ac5 100644 --- a/bench/Benchmark.hs +++ b/test/bench/Benchmark.hs @@ -9,8 +9,6 @@ import Control.Lens ((&), (.~), (^.)) import Control.Monad (replicateM_) import Control.Monad.Except (runExceptT) import Control.Monad.State (evalStateT, execStateT) -import Criterion.Main (Benchmark, bench, bgroup, defaultConfig, defaultMainWith, whnfAppIO) -import Criterion.Types (Config (timeLimit)) import Data.Map qualified as M import Swarm.Game.CESK (emptyStore, initMachine) import Swarm.Game.Display (defaultRobotDisplay) @@ -24,9 +22,11 @@ import Swarm.Game.World (WorldFun (..), newWorld) import Swarm.Language.Context qualified as Context import Swarm.Language.Pipeline (ProcessedTerm) import Swarm.Language.Pipeline.QQ (tmQ) +import Swarm.Language.Syntax import Swarm.TUI.Model (gameState) import Swarm.TUI.Model.StateUpdate (classicGame0) import Swarm.Util.Erasable +import Test.Tasty.Bench (Benchmark, bcompare, bench, bgroup, defaultMain, whnfAppIO) -- | The program of a robot that does nothing. idleProgram :: ProcessedTerm @@ -74,6 +74,40 @@ circlerProgram = ) |] +-- | The program of a robot that moves back and forth. +-- +-- Each robot in a line starts a tick later, forming a wave. +-- See data/scenarios/Challenges/wave.yaml +-- +-- This is used to compare the performance degradation caused +-- by using definitions and chains of ifs. Ideally there should +-- not be cost if the code is inlined and simplified. TODO: #1557 +waveProgram :: Bool -> ProcessedTerm +waveProgram manualInline = + let inlineDef = if manualInline then (1 :: Integer) else 0 + in [tmQ| + def doN = \n. \f. if (n > 0) {f; doN (n - 1) f} {}; end; + def crossPath = + if ($int:inlineDef == 0) { + doN 6 move; + } { + move; move; move; move; move; move; + }; + turn back; + wait 5; + end; + def go = + crossPath; + go; + end; + def start = + pos <- whereami; + wait $ fst pos; + go; + end; + start; + |] + -- | Initializes a robot with program prog at location loc facing north. initRobot :: ProcessedTerm -> Location -> TRobot initRobot prog loc = mkRobot () Nothing "" mempty (Just $ Cosmic DefaultRootSubworld loc) north defaultRobotDisplay (initMachine prog Context.empty emptyStore) [] [] False False mempty 0 @@ -97,26 +131,35 @@ runGame numGameTicks = evalStateT (replicateM_ numGameTicks gameTick) main :: IO () main = do - idlers <- mkGameStates idleProgram [10, 20 .. 40] - trees <- mkGameStates treeProgram [10, 20 .. 40] - circlers <- mkGameStates circlerProgram [10, 20 .. 40] - movers <- mkGameStates moverProgram [10, 20 .. 40] + idlers <- mkGameStates idleProgram + trees <- mkGameStates treeProgram + circlers <- mkGameStates circlerProgram + movers <- mkGameStates moverProgram + wavesInlined <- mkGameStates (waveProgram True) + wavesWithDef <- mkGameStates (waveProgram False) -- 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. - defaultMainWith - (defaultConfig {timeLimit = 10}) + defaultMain [ bgroup "run 1000 game ticks" [ bgroup "idlers" (toBenchmarks idlers) , bgroup "trees" (toBenchmarks trees) , bgroup "circlers" (toBenchmarks circlers) , bgroup "movers" (toBenchmarks movers) + , bgroup "wavesInlined" (toBenchmarks wavesInlined) + , bgroup + "wavesWithDef" + ( zipWith (\i -> bcompare ("wavesInlined." <> show i)) robotNumbers $ + toBenchmarks wavesWithDef + ) ] ] where - mkGameStates :: ProcessedTerm -> [Int] -> IO [(Int, GameState)] - mkGameStates prog sizes = zip sizes <$> mapM (mkGameState (initRobot prog)) sizes + robotNumbers = [10, 20 .. 40] + + mkGameStates :: ProcessedTerm -> IO [(Int, GameState)] + mkGameStates prog = zip robotNumbers <$> mapM (mkGameState (initRobot prog)) robotNumbers toBenchmarks :: [(Int, GameState)] -> [Benchmark] toBenchmarks gameStates =