nofib Benchmarks (#251)

hkmc2/shared/src/test/mlscript/nofib/ansi.mls

@@ -0,0 +1,95 @@
+:js
+
+:import NofibPrelude.mls
+//│ Imported 112 member(s)
+
+let cls = nofibStringToList("L")
+//│ cls = Cons { head: 'L', tail: Nil { class: [class Nil] } }
+
+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, use, cs) = if cs is
+  Nil then eof(Nil)
+  c :: cs then use(c, cs)
+
+fun peekChar(eof, use, cs) = if cs is
+  Nil then eof(Nil)
+  c :: cs then use(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, use) = use(reverse(s))
+
+:...
+//│ ————————————————————————————————————————————————————————————————————————————————
+fun deletee(n, s, l, use) = if n > 0 then writeString(nofibStringToList("BS_BS"), loop(n - 1, tail(s), l, use)) else ringBell(loop(0, nofibStringToList(""), l, use))
+
+fun loop(n, s, l, use) = x => readChar of
+  returnn(s, use)
+  (c, d) => if
+            c == "B" then deletee(n, s, l, use) 
+            c == "D" then deletee(n, s, l, use)
+            c == "`" then returnn(s, use)
+            n < l then writeChar(c, loop(n + 1, c :: s, l, use), d)
+            else ringBell(loop(n, s, l, use), d)
+  x
+//│ ————————————————————————————————————————————————————————————————————————————————
+
+fun readAt(x_y, l, use) = writeAt(x_y, replicate(l, "_"), moveTo(x_y, loop(0, "", l, use)))
+
+fun promptReadAt(x_y, l, prompt, use) = if x_y is [x, y] then
+  writeAt([x, y], prompt, readAt([x + listLen(prompt), y], l, use))
+
+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"))
+
+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..."

hkmc2/shared/src/test/mlscript/nofib/atom.mls

@@ -1,22 +1,23 @@
 :js
+
 :import NofibPrelude.mls
-//│ Imported 109 member(s)
+//│ Imported 112 member(s)
 
 
 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 Cons(f, fs) and gs is Cons(g, gs) then (f + g) :: dotPlus(fs, gs)
+  fs is f :: fs and gs is g :: gs then (f + g) :: dotPlus(fs, gs)
 
 fun dotMult(fs, gs) = if
-  fs is Cons(f, fs) and gs is Cons(g, gs) then (f * g) :: dotMult(fs, gs)
+  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
-  Cons(f, fs) then (c * f) :: scalarMut(c, fs)
+  f :: fs then (c * f) :: scalarMut(c, fs)
 
 fun testforce(k, ss) = lazy of () =>
   if force(ss) is
@@ -25,7 +26,7 @@ fun testforce(k, ss) = lazy of () =>
 fun show(s) =
   fun lscomp(ls) = if ls is
     Nil then Nil
-    Cons(component, t) then Cons(stringConcat(stringOfFloat(component), "\t"), lscomp(t))
+    component :: t then Cons(stringConcat(stringOfFloat(component), "\t"), lscomp(t))
   if s is State(pos, vel) then
     stringListConcat of lscomp(pos)
 
@@ -39,8 +40,8 @@ fun runExperiment(law, dt, param, init) = lazy of () =>
 fun testAtom_nofib(n) =
   fun lscomp(ls) = if ls is
     Nil then Nil
-    Cons(state, t) then Cons(stringConcat(show(state), "\n"), lscomp(t))
-  stringListConcat of lscomp(take_lz(n, runExperiment(testforce, 0.02, Cons(1.0, Nil), State(Cons(1.0, Nil), Cons(0.0, 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