Add wave program to benchmarks (#1576)

* add wave program and parametrise it to compare inlined/generic version
* use [`tasty-bench`](https://hackage.haskell.org/package/tasty-bench) library to show comparison
* move benchmarks to test folder as they can now share tasty code
* closes #1574 

Using the recursive definition with ifs leads to a 3x slowdown:
```
wavesInlined
  10: OK
    361  ms ±  29 ms
  20: OK
    718  ms ±  35 ms
  30: OK
    1.066 s ±  28 ms
  40: OK
    1.437 s ±  37 ms
wavesWithDef
  10: OK
    1.052 s ±  51 ms, 2.92x
  20: OK
    2.117 s ±  34 ms, 2.95x
  30: OK
    3.144 s ±  80 ms, 2.95x
  40: OK
    4.191 s ±  91 ms, 2.92x
```
But if we just inline and simplify the code, we can remove the runtime overhead completely.

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
+fourmolu --mode=inplace src app test

swarm.cabal

@@ -396,17 +396,16 @@ 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,
                   mtl,
                   random,
                   swarm,
                   text,
-                  containers
+                  containers,
   default-language: Haskell2010
   ghc-options:      -threaded

bench/Benchmark.hs → 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 =