Benchmarking subproject

benchmark/src/main/scala/Benchmark.scala

@@ -0,0 +1,193 @@
+package hkmc2
+
+import mlscript.utils.*, shorthands.*
+
+import hkmc2.Config.EffectHandlers
+import hkmc2.Config.StackSafety
+import hkmc2.Config.LiftDefns
+
+object Benchmark {
+  val targetBaseDir = os.pwd/"benchmark"/"target"
+  val benchmarkBaseDir = os.pwd/"benchmark"/"src"
+  val runtimeRelPath = os.rel/"precompiled"/"Runtime.mjs"
+  val noInstrDir = targetBaseDir/"noInstr"
+  val effectOnlyDir = targetBaseDir/"effectOnly"
+  val stackSafeDir = targetBaseDir/"stackSafe"
+
+  val preludePath = os.pwd/"hkmc2"/"shared"/"src"/"test"/"mlscript"/"decls"/"Prelude.mls"
+  val compilerNoInstr = MLsCompiler(preludePath, _(println))(using Config(N, N, S(LiftDefns())))
+  val compilerInstr = MLsCompiler(preludePath, _(println))(using Config(N, S(EffectHandlers(false, N)), S(LiftDefns())))
+  val compilerStackSafe = MLsCompiler(preludePath, _(println))(using Config(N, S(EffectHandlers(false, S(StackSafety.default))), N))
+  val compilerStackSafeLifted = MLsCompiler(preludePath, _(println))(using Config(N, S(EffectHandlers(false, S(StackSafety.default))), S(LiftDefns())))
+
+  val configsLst =
+      (noInstrDir, compilerNoInstr, "only lifting") ::
+      (effectOnlyDir, compilerInstr, "lifting and effect") ::
+      (stackSafeDir, compilerStackSafeLifted, "lifting, effect, and stack safety") :: Nil
+
+  val configs = configsLst.map((p, c, _) => (p, c))
+
+  def compileFile(file: os.RelPath, targetDir: os.Path, compiler: MLsCompiler, exportName: Option[Str] = N, outFileOpt: Option[os.RelPath] = N) =
+    val outFile = outFileOpt.getOrElse(file/os.up/(file.baseName + ".mjs"))
+    compiler.compileModule(benchmarkBaseDir/file, S(targetDir/outFile), exportName, S(benchmarkBaseDir/runtimeRelPath), true)
+
+  def compileVersions(file: os.RelPath, configs: List[(os.Path, MLsCompiler)]) =
+    configs.foreach: (targetDir, compiler) =>
+      compileFile(file, targetDir, compiler)
+
+  def precompileModules =
+
+    compileVersions(os.rel/"precompiled"/"Runtime.mls", configs.map((targetDir, _) => (targetDir, compilerNoInstr)))
+    compileVersions(os.rel/"precompiled"/"Rendering.mls", configs.map((targetDir, _) => (targetDir, compilerNoInstr)))
+
+    configs.foreach: (targetDir, _) =>
+      os.copy.over(benchmarkBaseDir/"precompiled"/"RuntimeJS.mjs", targetDir/"precompiled"/"RuntimeJS.mjs")
+
+    compileVersions(os.rel/"precompiled"/"Predef.mls", configs)
+    compileVersions(os.rel/"precompiled"/"NofibPrelude.mls", configs)
+
+    configs.foreach: (targetDir, compiler) =>
+      val inFile = if compiler is compilerStackSafeLifted then
+        os.rel/"precompiled"/"BenchmarkPrelude.instr.mls"
+      else
+        os.rel/"precompiled"/"BenchmarkPrelude.noinstr.mls"
+      compileFile(inFile, targetDir, compiler, S("BenchmarkPrelude"), S(os.rel/"precompiled"/"BenchmarkPrelude.mjs"))
+
+  def main(args: Array[String]) =
+
+    println("Compiling dependencies")
+    precompileModules
+    val testDir = os.pwd/"hkmc2"/"shared"/"src"/"test"
+    // Import nofib
+    val nofibSources = os.list(os.pwd/"hkmc2"/"shared"/"src"/"test"/"mlscript"/"nofib").filter(_.last != "NofibPrelude.mls").filter(_.last != "input")
+    nofibSources.foreach: path =>
+      println(s"Importing ${path.last}")
+      val preludeStr = f"""import "../precompiled/NofibPrelude.mls"
+import "../precompiled/BenchmarkPrelude.mls"
+import "fs"
+open NofibPrelude
+open BenchmarkPrelude
+
+module ${path.baseName.replace("-", "")} with ...
+"""
+      val result = os.read(path).split("\n").flatMap: line =>
+          if line.startsWith(":") || line.startsWith("import ") || line.startsWith("//|") then
+            N
+          else if line.startsWith("prog(6).toStr") || line.startsWith("test") || line.startsWith("nofib") ||
+            line.startsWith("map(x => nofib") then
+            S(f"fun main() = $line")
+          else if line.startsWith("print(test") || line.startsWith("print(nofib") then
+            assert(line.endsWith(")"))
+            S(f"fun main() = ${line.drop(6).dropRight(1)}")
+          else if line == "print of" then
+            S("fun main() =")
+          else if line.startsWith("let ls = testFish") then
+            S("fun main() = testFish_nofib(1)")
+          else if line == "ls" && path.baseName == "fish" then
+            S("")
+          else if line.startsWith("let ") then
+            // convert private variables away
+            S("val " + line.drop(4))
+          else
+            S(line)
+        .mkString(preludeStr, "\n", "\n")
+      os.write.over(os.pwd/"benchmark"/"src"/"nofib"/path.last.replace("-", ""), result)
+    println("Compiling nofib")
+    val nofibPaths = os.list(benchmarkBaseDir/"nofib")
+    nofibPaths.foreach: path =>
+      println(s"=> Compiling ${path.last}")
+      compileVersions(os.rel/"nofib"/path.last, configs)
+
+    val results = nofibPaths.map: path =>
+      println(s"=> Running ${path.last}")
+      val result = configsLst.map: (targetDir, _, nme) =>
+        println(s"=> => Running ${path.last} with $nme")
+        val targetImport = s"import Target from \"${targetDir/"nofib"/(path.baseName + ".mjs")}\";\n"
+        val benchmarkImport = s"import Benchmark from \"${targetDir/"precompiled"/"BenchmarkPrelude.mjs"}\";\n"
+        val benchmarkJS = targetImport + benchmarkImport + "Benchmark.benchmark(Target.main)"
+        val result = os.proc("node").call(stdin = benchmarkJS, stderr = os.Inherit)
+        val resultStr = result.out.bytes.map(_.toChar).mkString
+        var time: Opt[Double] = N
+        resultStr.linesIterator.foreach: line =>
+          if line.startsWith("Time: ") then
+            val t = line.substring(6, line.length - 2).toDouble
+            println(f"Time: $t%.3f")
+            time = S(t)
+          else if line.startsWith("stackSafeCounter: ") then
+            println(line)
+          else
+            println(line)
+        time
+      val folded = result.foldRight(S(List.empty): Opt[List[Double]]): (r, acc) =>
+        (r, acc) match
+          case (S(t), S(lst)) => S(t :: lst)
+          case _ => N
+      folded.foreach: lst =>
+        println(f"Effect compared with baseline: ${lst.head / lst(1) * 100}%.3f%%")
+        println(f"Stack safety compared with effect: ${lst(1) / lst(2) * 100}%.3f%%")
+        println(f"Stack safety compared with baseline: ${lst.head / lst(2) * 100}%.3f%%")
+      (path, folded)
+
+    results.foreach: (path, result) =>
+      result match
+        case S(baseline :: effect :: stackSafe :: Nil) =>
+          println(f"$path: ${(baseline / effect) * 100}%.3f%%, ${(baseline / stackSafe) * 100}%.3f%%")
+        case _ =>
+          println(s"$path: One of the test failed")
+
+    // val results = nofibFiles.map: path =>
+    //   def run(compiler: MLsCompiler): Option[Double] =
+    //     // println(s"Compiling $path")
+    //     compiler.compileModule(path)
+    //     val resultPath = path / os.up / (path.baseName + ".mjs")
+    //     println(s"Running $resultPath")
+    //     val result = os.proc("node", resultPath.toString).call(stderr = os.Inherit)
+    //     val resultStr = result.out.bytes.map(_.toChar).mkString
+    //     var time: Opt[Double] = N
+    //     resultStr.linesIterator.foreach: line =>
+    //       if line.startsWith("Time: ") then
+    //         val t = line.substring(6, line.length - 2).toDouble
+    //         println(f"Time: $t%.3f")
+    //         time = S(t)
+    //       else if line.startsWith("stackSafeCounter: ") then
+    //         println(line)
+    //       else
+    //         println(line)
+    //     time
+    //   // if path.last != "cryptarithm1.mls" then
+    //   //   useStackSafe
+    //   //   println("Stack safety: on")
+    //   //   run(compilerStackSafe)
+    //   // else
+    //   //   print("Skipping cryptarithm1 as it OOM without lifter")
+    //   useStackSafe
+    //   println("Stack safety: on, Lift: on")
+    //   val t1 = run(compilerStackSafeLifted)
+    //   useNoInstr
+    //   println("Stack safety: off")
+    //   val t2 = run(compilerNoInstr)
+    //   (t1, t2) match
+    //     case (S(t1), S(t2)) =>
+    //       val s1 = 1 / t1
+    //       val s2 = 1 / t2
+    //       println(f"Speed compared with stack safety off: ${s1 / s2 * 100}%.3f%%")
+    //       path.last -> S(s1 / s2)
+    //     case (S(_), N) =>
+    //       path.last -> N
+    //     case _ =>
+    //       println("Stack safe version failed")
+    //       path.last -> N
+    // results.foreach: (path, result) =>
+    //   result match
+    //     case S(speed) =>
+    //       println(f"$path: ${speed * 100}%.3f%%")
+    //     case N =>
+    //       println(s"$path: One of the test failed")
+    // val speeds = results.collect { case (_, S(speed)) => speed }
+    // val avg = speeds.sum / speeds.length
+    // println(f"Average speed ratio: ${avg * 100}%.3f%%")
+    // val std = math.sqrt(speeds.map(s => (s - avg) * (s - avg)).sum / speeds.length)
+    // println(f"Standard deviation: ${std * 100}%.3f%%")
+    // println(f"Min speed ratio: ${speeds.min * 100}%.3f%%")
+    // println(f"Max speed ratio: ${speeds.max * 100}%.3f%%")
+}

benchmark/src/nofib/ansi.mls

@@ -0,0 +1,98 @@
+import "../precompiled/NofibPrelude.mls"
+import "../precompiled/BenchmarkPrelude.mls"
+import "fs"
+open NofibPrelude
+open BenchmarkPrelude
+
+module ansi with ...
+
+
+val cls = nofibStringToList("L")
+//│ cls = ["L"]
+
+fun goto(x, y) = "E" :: "[" :: (nofibStringToList(stringOfInt(y)) +: (";" :: nofibStringToList(stringOfInt(x)) +: nofibStringToList("H")))
+
+fun at(x_y, s) = if x_y is [x, y] then goto(x, y) +: s
+
+fun highlight(s) = nofibStringToList("ESC[7m") +: s +: nofibStringToList("ESC[0m")
+
+fun end(xs) = nofibStringToList("")
+
+fun readChar(eof, consume, cs) = if cs is
+  Nil then eof(Nil)
+  c :: cs then consume(c, cs)
+
+fun peekChar(eof, consume, cs) = if cs is
+  Nil then eof(Nil)
+  c :: cs then consume(c, c :: cs)
+
+fun pressAnyKey(prog, x) = readChar(prog, (c, x) => prog(x), x)
+
+fun unreadChar(c, prog, cs) = prog(c :: cs)
+
+fun writeChar(c, prog, cs) = c :: prog(cs)
+
+fun writeString(s, prog, cs) = s +: prog(cs)
+
+fun writes(ss, a, b) = writeString(concat(ss), a, b)
+
+fun ringBell(prog, cs) = writeChar("B", prog, cs)
+
+fun clearScreen(a, b) = writeString(cls, a, b)
+
+fun writeAt(x_y, s, a) = if x_y is [x, y] then p => writeString(goto(x, y) +: s, a, p)
+
+fun moveTo(x_y, a) = if x_y is [x, y] then p => writeString(goto(x, y), a, p)
+
+fun returnn(s, consume) = consume(reverse(s))
+
+//│ ————————————————————————————————————————————————————————————————————————————————
+fun deletee(n, s, l, consume, d) = if n > 0 then writeString(nofibStringToList("BS_BS"), loop(n - 1, tail(s), l, consume), d) else ringBell(loop(0, nofibStringToList(""), l, consume), d)
+
+fun loop(n, s, l, consume) = x => readChar of
+  returnn(s, consume)
+  (c, d) => if
+            c == "B" then deletee(n, s, l, consume, d) 
+            c == "D" then deletee(n, s, l, consume, d)
+            c == "`" then returnn(s, consume)(d)
+            n < l then writeChar(c, loop(n + 1, c :: s, l, consume), d)
+            else ringBell(loop(n, s, l, consume), d)
+  x
+//│ ————————————————————————————————————————————————————————————————————————————————
+
+fun readAt(x_y, l, consume) = writeAt(x_y, replicate(l, "_"), moveTo(x_y, loop(0, "", l, consume)))
+
+fun promptReadAt(x_y, l, prompt, consume) = if x_y is [x, y] then
+  writeAt([x, y], prompt, readAt([x + listLen(prompt), y], l, consume))
+
+fun program(input) = writes(
+  cls ::
+  at([17, 5], highlight(nofibStringToList("Demonstration program"))) ::
+  at([48, 5], nofibStringToList("Version 1.0")) ::
+  at([17, 7], nofibStringToList("This program illustrates a simple approach")) ::
+  at([17, 8], nofibStringToList("to screen-based interactive programs using")) ::
+  at([17, 9], nofibStringToList("the Hugs functional programming system.")) ::
+  at([17, 11], nofibStringToList("Please press any key to continue ...")) ::
+  Nil,
+  x => pressAnyKey(promptReadAt(
+    [17, 15],
+    18,
+    nofibStringToList("Please enter your name: "),
+    (name) =>
+      let reply = nofibStringToList("Hello ") +: name +: nofibStringToList("!")
+      writeAt(
+        [40 - (listLen(reply) / 2), 18],
+        reply,
+        moveTo(
+          [1, 23],
+          y => writeString(nofibStringToList("I'm waiting..."), x => pressAnyKey(end, x), y)
+        )
+      )
+  ), x),
+  input
+)
+
+fun testAnsi_nofib(n) = foldr(compose, (x) => x, replicate(n, program))(nofibStringToList("testtesttest"))
+
+fun main() = nofibListToString(testAnsi_nofib(1))
+//│ = "LE[5;17HESC[7mDemonstration programESC[0mE[5;48HVersion 1.0E[7;17HThis program illustrates a simple approachE[8;17Hto screen-based interactive programs usingE[9;17Hthe Hugs functional programming system.E[11;17HPlease press any key to continue ...E[15;17HPlease enter your name: E[15;41H__________________E[15;41HesttesttestE[18;31HHello esttesttest!E[23;1HI'm waiting..."

benchmark/src/nofib/atom.mls

@@ -0,0 +1,53 @@
+import "../precompiled/NofibPrelude.mls"
+import "../precompiled/BenchmarkPrelude.mls"
+import "fs"
+open NofibPrelude
+open BenchmarkPrelude
+
+module atom with ...
+
+
+
+data class State(position: List[Num], velocity: List[Num])
+
+fun dotPlus(fs, gs) = if
+  fs is Nil then gs
+  gs is Nil then fs
+  fs is f :: fs and gs is g :: gs then (f + g) :: dotPlus(fs, gs)
+
+fun dotMult(fs, gs) = if
+  fs is f :: fs and gs is g :: gs then (f * g) :: dotMult(fs, gs)
+  else Nil
+
+fun scalarMut(c, fs) = if fs is
+  Nil then Nil
+  f :: fs then (c * f) :: scalarMut(c, fs)
+
+fun testforce(k, ss) = lazy of () =>
+  if force(ss) is
+    LzCons(State(pos, vel), atoms) then LzCons(dotMult(scalarMut(-1.0, k), pos), testforce(k, atoms))
+
+fun show(s) =
+  fun lscomp(ls) = if ls is
+    Nil then Nil
+    component :: t then Cons(stringConcat(stringOfFloat(component), "\t"), lscomp(t))
+  if s is State(pos, vel) then
+    stringListConcat of lscomp(pos)
+
+fun propagate(dt, aforce, state) = if state is State(pos, vel) then
+  State(dotPlus(pos, scalarMut(dt, vel)), dotPlus(vel, scalarMut(dt, aforce)))
+
+fun runExperiment(law, dt, param, init) = lazy of () =>
+  let stream = runExperiment(law, dt, param, init)
+  LzCons(init, zipWith_lz_lz((x, y) => propagate(dt, x, y), law(param, stream), stream))
+
+fun testAtom_nofib(n) =
+  fun lscomp(ls) = if ls is
+    Nil then Nil
+    state :: t then stringConcat(show(state), "\n") :: lscomp(t)
+  stringListConcat of lscomp(take_lz(n, runExperiment(testforce, 0.02, 1.0 :: Nil, State(1.0 :: Nil, 0.0 :: Nil))))
+
+
+// NOTE: original input 1000
+fun main() = testAtom_nofib(20)
+//│ = "1\t\n1\t\n0.9996\t\n0.9988\t\n0.9976001600000001\t\n0.9960008\t\n0.994002399936\t\n0.991605599552\t\n0.9888111982080257\t\n0.9856201546242305\t\n0.982033586561152\t\n0.978052770436224\t\n0.9736791408766714\t\n0.9689142902089444\t\n0.9637599678848666\t\n0.9582180798447053\t\n0.95229068781739\t\n0.9459800085581369\t\n0.9392884130237569\t\n0.9322184254859536\t\n"